循环表单和传输数据
我的大脑被炸，这对于通常的嫌疑犯来说很容易。 div是一个包含表单名称的数组。 我循环浏览主书中的表格，如果其中一个主表格匹配div数组中的一个表格，我想将一些数据从主表格转移到本工作表中的表格中。
如果工作表中不存在该工作表，请添加一个工作表并将其命名为主工作表。 什么是最有效的方法来做到这一点？ 我觉得像嵌套循环是一个坏主意-_-可能是一个集合？
For i = 0 To UBound(div()) For Each s In book.Worksheets wsName = Left(s.Name, 5) If div(i) = wsName Then If wsExists(wsName) Then Set ws = ThisWorkbook.Worksheets(wsName) Exit For 'Debug.Print "true " & ws.name Else Set ws = ThisWorkbook.Worksheets.Add ws.Name = Left(s.Name, 5) 'Debug.Print "false " & ws.name End If end if Next With ws .Columns(Start).Resize(, 2).Value = s.Columns("A:B").Value .Columns(Start + label).Resize(, cols).Value = s.Columns(Start + label).Resize(, cols).Value End With Next
我甚至需要检查表单是否存在？ 从蒂姆窃取的代码。
Function wsExists(sName As String) As Boolean Dim sht As Worksheet On Error Resume Next Set sht = ThisWorkbook.Sheets(sName) On Error GoTo 0 wsExists = Not sht Is Nothing End Function
编辑：我从一个单独的例程调用循环。
Call drop(thisWB, thisRange, ccArr)
ccArr在哪里
Dim ccArr() As Variant ccArr = Array("30500", "30510", "30515", "30530", "30600", "30900", "40500")
上面的循环驻留的例程打开
Sub drop(book As Workbook, cols As Integer, div As Variant, Optional startCol As Integer)
但我得到一个byref错误尝试传递数组; _;
你的嵌套循环是多余的。 您可以直接检查您要检查的工作簿的表格名称，然后根据需要添加它。
请参阅下面的代码，这也解决了对您的OP进行编辑时所关心的问题。 我修改了wsExists函数以包含对特定工作簿的集合引用，我认为这使得它更具dynamic性。
'assumes thisWB and thisRange set above Dim ccArr() As String, sList As String sList = "30500,30510,30515,30530,30600,30900,40500" ccArr = Split(sList, ",") drop thisWB, thisRange, ccArr 'assumes thisWb and thisRange are set already ' rest of code '================================================== Sub drop(book As Workbook, cols As Integer, div() As String, Optional startCol as Integer) For i = 0 To UBound(div()) If wsExists(ThisWorkbook, div(i)) Then Set ws = ThisWorkbook.Worksheets(div(i)) Exit For 'Debug.Print "true " & ws.name Else Set ws = ThisWorkbook.Worksheets.Add ws.Name = div(i) End If 'i think you need this here, otherwise, it will only work on the last worksheet in your loop With ws Dim s As Worksheet Set s = book.Sheets(div(i)) .Columns(Start).Resize(, 2).Value = s.Columns("A:B").Value .Columns(Start + Label).Resize(, cols).Value = s.Columns(Start + Label).Resize(, cols).Value End With Next End Sub Function wsExists(wb As Workbook, sName As String) As Boolean Dim sht As Worksheet On Error Resume Next Set sht = wb.Sheets(sName) On Error GoTo 0 wsExists = Not sht Is Nothing End Function
相关的重新调整代码：
此语句ws.Columns(1).Resize(, 2)转换为“从第1列和第2列开始的200万行”
你find的解决scheme效果很好，但它不是dynamic的（硬编码的最后一行）
这是我如何设置列的副本：
Option Explicit Public Sub copyCols() Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range Dim cols As Long, lr As Long Dim col1 As Long 'renamed from "Start" (VBA keyword - property) Dim lbl As Long 'renamed from "label" (VBA keyword - Control object) Set ws1 = Sheet1 'ws Set ws2 = Sheet2 'book.Worksheets(wsName & "-F") col1 = 1 cols = 2 lbl = 1 lr = ws2.Cells(ws2.UsedRange.Row + ws2.UsedRange.Rows.Count, "A").End(xlUp).Row Set rng1 = ws1.Range(ws1.Cells(1, col1), ws1.Cells(lr, col1 + 1)) Set rng2 = ws2.Range("A1:B" & lr) rng1.Value2 = rng2.Value2 Set rng1 = ws1.Range(ws1.Cells(1, col1 + lbl), ws1.Cells(lr, col1 + lbl + cols)) Set rng2 = ws2.Range(ws2.Cells(1, col1 + lbl), ws2.Cells(lr, col1 + lbl + cols)) rng1.Value2 = rng2.Value2 End Sub