VBA 通过数组并行循环



我正在尝试通过专门链接的特定工作表和列创建一个循环,但这不起作用,我是否误解了如何使用数组?

Sub test()
Dim wb As Workbook, big, rc, sr  As Worksheet, rejcheck, copyto, arr As variant
Set wb = ActiveWorkbook
Set big = wb.Sheets("BIG")
Set oou = wb.Sheets("OOU")
Set sr = wb.Sheets("SR")
rejcheck = Array(big, sr, oou)
copyto = Array(47, 23, 58)
arr = Array(rejcheck, copyfrom)
For Each x In arr
With rejcheck
.Range("a2").Copy wb.Sheets("other sheet").Cells(1, copyto)
wb.Sheets("other sheet").Cells(1, copyto).Offset(0, 1).Value = .Name
End With
Next x
End Sub

基本上,我希望以并行方式循环这些关联值,((big, 47),(sr,23),(oou,58))第一个作为源表,第二个作为目标表的列号。 有什么帮助吗?

不能创建数组并将其视为工作表。而且您不需要将两个数组放在一个数组中。最后,看起来您想执行以下操作:

Option Base 0
Sub test()
Dim wb As Workbook, big, oou, sr  As Worksheet, rejcheck, copyto, x As Variant
Dim i As Integer
Set wb = ActiveWorkbook
Set big = wb.Sheets("BIG")
Set oou = wb.Sheets("OOU")
Set sr = wb.Sheets("SR")
rejcheck = Array(big, sr, oou)
copyto = Array(47, 23, 58)
For i = 0 To UBound(rejcheck)
With rejcheck(i)
.Range("a2").Copy wb.Sheets("other sheet").Cells(1, copyto(i))
wb.Sheets("other sheet").Cells(1, copyto(i)).Offset(0, 1).Value = .Name
End With
Next
End Sub

变量声明big, rc, sr As Worksheet表示sr As Worksheet,而rcsrVariant。另外,你不是Dimxanyehere。如果在代码顶部使用Option Explicit>>则 VBA 编辑器会"尖叫"错误。

下一步:如果要使用arr,然后并行循环遍历它,则需要定义并设置arr为 2-D 数组,并读取rejcheck并向其copyto数组值。

法典

Option Explicit
Sub test()
Dim wb As Workbook
Dim big As Worksheet, rc As Worksheet, sr As Worksheet, oou As Worksheet
Dim rejcheck As Variant, copyto As Variant, arr As Variant, x As Variant
Dim i As Long
Set wb = ActiveWorkbook
Set big = wb.Sheets("BIG")
Set oou = wb.Sheets("OOU")
Set sr = wb.Sheets("SR")
rejcheck = Array(big, sr, oou)
copyto = Array(47, 23, 58)
' define 2-D array according to size of rejcheck array
ReDim arr(0 To UBound(rejcheck), 0 To 1)
' loop through the elements and insert to 2-d array (1 of sheets, second of numeric values)
For i = LBound(rejcheck) To UBound(rejcheck)
Set arr(i, 0) = rejcheck(i) ' <-- use Set when adding Worksheet object
arr(i, 1) = copyto(i)
Next i
For i = LBound(arr, 1) To UBound(arr, 1)
With arr(i, 0)
.Range("A2").Copy wb.Sheets("other sheet").Cells(1, arr(i, 1))
wb.Sheets("other sheet").Cells(1, arr(i, 1)).Offset(0, 1).Value = .Name
End With
Next i
End Sub

最新更新