Question

大家下午好，

我不确定我是否可以正确解释。我有一个宏，它从一张工作表中按行过滤信息，并只将必要的四列记录到一个二维数组中。结果数组当前是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栏 - 金额。

现在，我有一个＆＃34; Actual＆＃34;表格，如下所示：

这是我的问题：宏是否可以通过＆＃34; Actual＆＃34;的第一列？如果值（例如，0290）与数组的第1列中的帐户代码匹配，则将数组中第2列和第4列（供应商名称和数量）的值粘贴到＆＃34; Actual＆＃34;第3栏和第6栏？然后转到＆＃34; Actual＆＃34;的下一行。如果数组中有另一行具有相同的帐户代码，则将其粘贴到下面，如果没有，则继续下一行，依此类推。

我很感激任何帮助。

P.S。我知道我可以使用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

Excel VBA - 根据工作表上的单元格值从数组中粘贴值

1 个答案: