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