配列を介して平行にループするVBA

Question

具体的にリンクされている特定のシートと列を使用してループを作成しようとしていますが、これは機能しません。

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))介して並列にループが対象シートの列番号ソースシートとして第一及び第二を有するたい。 助けてください？

Answer 1

。また、2つの配列を配列に配置する必要はありません。結局、あなたは次のようなことをしたいように見えます：

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 

Answer 2

変数宣言：big, rc, sr As Worksheetrcとsrはあなたがx anyehereをINGのないDimされ、Variant .Alsoありながら、sr As Worksheetを意味します。コードの先頭にOption Explicitを使用すると、VBAエディタはエラーを「悲鳴を上げる」でしょう。

次に：あなたがarrを使用し、並列に、それを介して後輪場合は、定義して2次元配列としてarrを設定し、それに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