excel - Excel VBA将数据拆分为表格
问题描述
我是 VBA 编码的新手,但我设法摸索了一遍。
我找到了这个并修改了我的要求,但我想指定要复制的列范围,即 A 到 Q。
任何帮助,将不胜感激。
Sub SplitData_ToPLCSheets()
'Split KEPServerCombined Column r into Separate Sheets ready for Export (PLC Name)
Const NameCol = "R"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim PLC As String
Excel_Tools.TurnEverythingOff ' Turn off Calc , Screen Updating and `enter code here`Calcs
Set SrcSheet = ThisWorkbook.Sheets("KEPServerCombined")
'Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).row
For SrcRow = FirstRow To LastRow
PLC = SrcSheet.Cells(SrcRow, NameCol).value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(PLC)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.name = PLC
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Excel_Tools.TurnEverythingOn ' Turn on Calc , Screen Updating and Calcs
End Sub
解决方案
感谢您的帮助 - 终于找到了一个有效的答案,但对于 30000 行来说很慢
Sub SplitData_ToPLCSheets()
'Split KEPServerCombined Column r into Separate Sheets ready for Export (PLC Name)
Const SrcCol_PLC = "R"
Const SrcRow_Headers = 1
Const SrcRow_FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.name = TrgName
SrcRange = "A" & Trim(Str(SrcRow_Headers)) & ":Q" & Trim(Str(SrcRow_Headers))
TrgRange = "A1"
SrcSheet.Range(SrcRange).Copy Destination:=TrgSheet.Range(TrgRange)
End If
' update the target row number to the first empty row on the target worksheet and copy data across
Set TrgSheet = Nothing
Set TrgSheet = Worksheets(TrgName)
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, 1).End(xlUp).Offset(1).Row
SrcRange = "A" & Trim(Str(SrcRow)) & ":Q" & Trim(Str(SrcRow))
TrgRange = "A" & Trim(Str(TrgRow))
SrcSheet.Range(SrcRange).Copy Destination:=TrgSheet.Range(TrgRange)
SrcRow = SrcRow + 1
DoEvents
Loop
Excel_Tools.TurnEverythingOn ' Turn on Calc , Screen Updating and Calcs
End Sub
推荐阅读
- c# - C# 和 CefSharp 中的 Selenium WebDriver
- flutter - 如何在 Flutter 中完全隐藏密码输入?
- java - 如何在 Java 中为单元测试创建“FTPS”模拟服务器,出现错误 - javax.net.ssl.SSLException: 502 Command not implemented: AUTH
- reactjs - 如果属性更改发生在嵌套对象中,React Redux 不会识别 prop 更改
- r - 如何将大型 640x 640 矩阵沿对角线分割许多(20-30)倍
- python - 烧瓶“[Errno 113] 没有路由到主机”,我不知道为什么
- sed - 使用 sed 将一个字符串替换为另一个具有正斜杠的字符串(在两个字符串中)
- communication - MODBUS中的起始地址和从地址有什么区别?
- javascript - JS 获取文本和元素边界之间的可用空间
- c++ - 如何从共享内存就地创建 STL 向量/数组?