我在 vba 中的条件求和代码显示错误

Question

Dim wb As Workbook
Dim ws As Worksheet                        'for looping worksheets
Dim i As Double    
Dim lastrowG As Long
Dim lastrow As Double

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    lastrowG = ws.Cells(Rows.Count, "G").End(xlUp).Row

            For i = 2 To lastrow                                                                        
                   ws.Cells(i, 12).Value = WorksheetFunction.SumIf(ws.Range("A1:A" & lastrow), ws.Cells(i, 9), ws.Range("G1:G" & lastrowG))
            Next i
Next ws

End Sub

我想比较A列的数据和I列的数据。如果数据相等，那么我想添加G列的数据并将其显示在L列中。我没有收到任何错误，但最终以excel没有响应而告终。 A 和 I 列中的数据是字符串。这是一个 94000 行数据。有谁知道可能是什么原因吗？

Answer 1

“Excel 没有响应”可能表示 Excel 仍在忙于计算。 Col A 和 Col I 中有超过 90k 行意味着最终需要进行超过 80 亿次比较（Col A 中的每个值与 Col I 中的每个值）。这需要时间...

我很快就做出了不同的尝试：

• 第一步，将 col A、col I 和 col G 中的所有值读取到内存中。

• 现在构建一个包含 col G 的所有值的字典，并对 col G 的所有值求和。

• 第三步是循环 A 列中的所有值并检查字典中是否有该值的条目。

• 最后一步是将结果写回工作表（进入 L 列）

相关代码片段：

With ws
    ' Read Data into arrays
    Dim Col1Data, Col2Data, NumData, ResultData
    Dim col1RowCount As Long, col2RowCount As Long
    col1RowCount = .Cells(.Rows.Count, "A").End(xlUp).row
    Col1Data = .Range("A2:A" & col1RowCount)
    col2RowCount = .Cells(.Rows.Count, "G").End(xlUp).row
    Col2Data = .Range("I2:I" & col2RowCount)
    NumData = .Range("G2:G" & col2RowCount)

    Dim sumDict As Dictionary
    Set sumDict = New Dictionary
    
    ' Loop over the data in Col2 (=I) and calculate the sum for every value
    Dim row As Long
    Dim key As String, value As Double
    For row = 1 To UBound(Col2Data)
        key = Col2Data(row, 1)
        value = NumData(row, 1)
        sumDict(key) = sumDict(key) + value
    Next
    
    ' Get the sum of every value Col1 (=A)
    ReDim ResultData(1 To UBound(Col1Data), 1 To 1)
    For row = 1 To UBound(Col1Data)
        key = Col1Data(row, 1)
        If sumDict.Exists(key) Then ResultData(row, 1) = sumDict(key)
    Next
    
    ' Write back result to dest column (=L)
    .Range("L2").Resize(UBound(Col1Data), 1) = ResultData
End With

添加对 Microsoft 脚本运行时 的引用（或使用后期绑定）以使代码正常工作（缺点：脚本运行时，因此 Mac 上不存在字典）。

我创建了一个包含 100.000 行的测试表，分别用于 A 列和 G 列。运行时间可能是 1/2 秒。

注意：在您的代码中，将

i

和

lastrow

的数据类型更改为

Long