Excel VBA-根據圖紙上的單元格值從陣列中粘貼值

Question

大家下午好，

我不確定是否可以正確解釋。 我有一個宏，可以從一張工作表中按行過濾信息，並且僅將必要的四列記錄到2D數組中。 生成的數組當前為96行4列，它可以有更多行，但僅限於四列。

當前代碼如下：

Dim my_array4() As Variant

Dim my_array3 As Variant
Dim i As Long, x As Long
Dim cnt As Long

cnt = ThisWorkbook.Worksheets("Cost Allocation").Evaluate("COUNTIFS(L4:L1060,""Actual"",J4:J1060,""<>"",D4:D1060,""<>"",G4:G1060,""<>0"")") + ThisWorkbook.Worksheets("Cost Allocation").Evaluate("COUNTIFS(L4:L1060,""Actual"",K4:K1060,""<>"",D4:D1060,""<>"",H4:H1060,""<>0"")")
If cnt > 0 Then
    ReDim my_array4(1 To cnt, 1 To 6) As Variant

    my_array3 = ThisWorkbook.Worksheets("Cost Allocation").Range("C5:O1060").Value
    x = 1
    For i = 1 To UBound(my_array3, 1)
        If my_array3(i, 10) = "Actual" And my_array3(i, 2) <> "" And my_array3(i, 5) <> 0 Then
            If my_array3(i, 6) <> 0 And my_array3(i, 9) <> "" Then
                my_array4(x, 1) = my_array3(i, 8)
                my_array4(x, 2) = my_array3(i, 2)
                my_array4(x, 3) = my_array3(i, 4)
                my_array4(x, 4) = my_array3(i, 5)
                x = x + 1
                my_array4(x, 1) = my_array3(i, 9)
                my_array4(x, 2) = my_array3(i, 2)
                my_array4(x, 3) = my_array3(i, 4)
                my_array4(x, 4) = my_array3(i, 6)
                x = x + 1
            Else
                my_array4(x, 1) = my_array3(i, 8)
                my_array4(x, 2) = my_array3(i, 2)
                my_array4(x, 3) = my_array3(i, 4)
                my_array4(x, 4) = my_array3(i, 5)
                x = x + 1
            End If
        End If
    Next i

    Sheets("Sheet1").Range("A1").Resize(UBound(my_array4, 1), 4) = my_array4
End If

如您所見，在代碼的第二行中，我只是將整個內容粘貼到Sheet1上。 這只是為了確保正確創建陣列。 這部分代碼將被刪除。

陣列設置如下：第1列-帳戶代碼； 第2欄-員工/供應商名稱； 第3欄-發票編號或其他內容； 第4欄-金額。

現在，我有一個“實際”工作表，如下所示：

這是我的問題：宏是否可以通過“實際”工作表的第一列，並且如果值（例如0290）與數組第1列中的帳戶代碼匹配，請粘貼第2列和第4列中的值（供應商）名稱和金額）將數組分別放入“實際”工作表的第3列和第6列？ 然后轉到“ Actual”的下一行，如果數組中的另一行具有相同的帳戶代碼，則將其粘貼到下面，如果沒有，則繼續到下一行，依此類推。

我將不勝感激。

PS我知道我可以使用INDEX / MATCH公式，但是“實際”表有7220行，使用該公式會減慢工作簿的速度。

Answer 1

也許這將需要一些調整。

 'Loop Actual sheet and update the rows
Dim wsActual As Worksheet
Set ws = ActiveWorkbook.Sheets("Actual")

Dim iRow As Integer
'You starting row in the actual sheet
iRow = 1
Dim iEndRow As Integer
'Set this.
iEndRow = 100

Dim aCompletedLookups() As String


'store the value from the actual sheet so we can test if it changed
Dim sLookupValue As String

'Store the Array location outside the loop so we can start at the last iteration if we need to
Dim iArrayRow As Integer

For iRow To iEndRow Step 1
    'lookup the value in the array and get the index if exist
    Dim foundMatch As Boolean
    foundMatch = False

    Dim iArrayStart As Integer
    iArrayStart = 0
    If sLookupValue = wsActual.Cells(iRow, 1).Value Then
        'This account code is the same as the previous so start the array loop at the last iteration.
        iArrayStart = iArrayRow + 1
        'if we have completed the array then there are no more records for this account.
        'Store this lookup value in an array so we can skip it next time it pops up.
        If iArrayStart > Ubound(my_array4) - 1 Then
            ReDim Preserve aCompletedLookups(Ubound(aCompletedLookups))
            aCompletedLookups(Ubound(aCompletedLookups) - 1) = sLookupValue
            'Continue tp the next iRow
            Goto NextIterationOfActual
        ElseIf
        'Check if this lookup value has exhausted the array already.
            Dim i As Integer
            For i = 0 To Ubound(aCompletedLookups) - 1 Step 1
                If sLookupValue = aCompletedLookups(i) Then
                    Goto NextIterationOfActual
                End If
            Next i
        End If      
    End If
    sLookupValue = wsActual.Cells(iRow, 1).Value

    For iArrayRow = iArrayStart To Ubound(my_array4) - 1 Step 1
        If my_array4(iArrayRow, 0) = sLookupValue Then
            foundMatch = True
            Exit For
        End If  
    Next iArrayRow

    If foundMatch Then
        'Update the Actual sheet
        wsActual.Cells(iRow, 3).Value = my_array4(iArrayRow, 2)
        wsActual.Cells(iRow, 6).Value = my_array4(iArrayRow, 4)
    End if
    NextIterationOfActual:  
Next iRow