Как я могу применить макрос ко всему столбцу?

Question

Я пытаюсь сопоставить данные из одной книги в другую. У меня есть цикл for, и я не могу понять, как перебрать весь столбец, не испортив первоначальный цикл.

Пожалуйста, помогите!

Это мой текущий код, где мне нужно запустить код для каждой ячейки, для которой я хочу получить данные:

Sub SKU_Match()
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=Application.GetOpenFilename)
wb.Activate

Dim sh As String
sh = wb.Worksheets(1).Name
Dim lastRow As Integer
Row1 = ActiveSheet.UsedRange.Rows.Count

Dim index(1 To 1000, 1 To 2) As String
Dim i As Variant, j As Integer

For i = 1 To 1000
   For j = 1 To 2
        If j = 1 Then
           index(i, j) = wb.Worksheets(sh).Cells(i, 4).Value
        ElseIf j = 2 Then
            index(i, j) = wb.Worksheets(sh).Cells(i, 10).Value
        End If
    Next j
Next i

wb.Close

For i = 1 To Row1
    If index(i, 1) = Range("A" & (ActiveCell.Row)).Value 
Then
        ActiveCell.Value = index(i, 2)
    End If
Next i


End Sub 

Я пробовал цикл таким образом, но тогда он просто введет данные для активной ячейки во все строки без отдельного применения макроса к каждой строке:

Sub SKU_Match()
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=Application.GetOpenFilename)
wb.Activate

Dim sh As String
sh = wb.Worksheets(1).Name
Dim lastRow As Integer
Row1 = ActiveSheet.UsedRange.Rows.Count

Dim index(1 To 1000, 1 To 2) As String
Dim i As Variant, j As Integer

For i = 1 To 1000
   For j = 1 To 2
        If j = 1 Then
           index(i, j) = wb.Worksheets(sh).Cells(i, 4).Value
        ElseIf j = 2 Then
            index(i, j) = wb.Worksheets(sh).Cells(i, 10).Value
        End If
    Next j
Next i

wb.Close
For k = 0 to 58
    For i = 1 To Row1
        If index(i, 1) = Range("A" & (ActiveCell.Row)).Value 
    Then
             ActiveCell.Offset(k,0).Value = index(i, 2)
        End If
    Next i
Next k


End Sub

Answer 1

Решение основано на предположении, что каждое значение найденного совпадения будет добавлено на лист в строке, соответствующей SKU, и смещение столбца будет увеличиваться для каждого найденного совпадения. Кроме того, я думаю, что нет необходимости хранить значения wb в массиве, это может быть непосредственно из wb. Даже если это близко к вашей цели, не стесняйтесь спрашивать.

Sub SKU_Match2()
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=Application.GetOpenFilename)
Dim sh As String
sh = wb.Worksheets(1).Name
Dim lastRow As Integer

ThisWorkbook.Activate
Row1 = ActiveSheet.UsedRange.Rows.Count


For i = 1 To Row1
K = 1   'Assumtion: offset column kept 0 and will be incremented for each found
    ValToMatch = ThisWorkbook.ActiveSheet.Range("A" & i).Value
        For j = 1 To 1000
        MatchVal = wb.Worksheets(sh).Cells(j, 4).Value
        ValtoAdd = wb.Worksheets(sh).Cells(j, 10).Value
            If MatchVal = ValToMatch Then
            K = K + 1   'Assumtion: each value of the match found will added to the worksheet in the
            'row corresponding to SKU and column offset will increment for each match found
            ThisWorkbook.ActiveSheet.Cells(i, K).Value = ValtoAdd
            End If
         Next j
Next i
wb.Close False
End Sub