VBA认证超过500k行

Question

我有一张大桌子，我已将其放入数据透视表中，但我想获得一个独特的计数，所以我试图在侧面设置辅助列。 1 /唯一计数，所以在枢轴中它总和回到1.我的公式是：

1 / COUNTIFS（B2：B460489，B2，I2：I460489，I2）

这应该可行，但由于我有近500k行，所以需要花费很长时间来计算。我也试图在VBA中进行计算，希望它会更快，但在退出之前仍然需要> 10分钟。

有没有让这个计算更容易管理？

基于使用数组的想法，我使用双循环得到了下面的代码，因为对于表中的每一行，我需要知道整个商店/产品发生了多少次表。它仍然太慢，是否有可能提高效率？

arr = Sheets("Data").Range("A2:AH" & lr)

ReDim Arr2(UBound(arr) - 1, 0)

For i = LBound(arr) To UBound(arr)
    Ans = 0
    For j = LBound(arr) To UBound(arr)
        If arr(j, 2) = arr(i, 2) And arr(j, 9) = arr(i, 9) Then 'And arr(j, 33) = 1 Then
            Ans = Ans + 1
        End If
    Next j
    If Ans > 0 Then
        arr(i, 34) = 1 / Ans
        Arr2(i - 1, 0) = arr(i, 34)
    End If
Next i

Sheets("Data").Range("AH2:AH" & lr) = Arr2

Answer 1

如何使用数组实现此目的的示例。我使用了4列与你描述的相似，但不完全正确，所以你需要稍微修改一下。如果您能够更清楚地了解正在发生的事情，我可以根据需要更新此问题以准确解决您的问题。

Option Explicit
Sub Example()
    Dim ans As Integer, i As Integer
    Dim arr() as variant

    arr = Range("B2:J8")

    For i = LBound(arr) To UBound(arr)
        If arr(i, 2) = 1 And arr(i, 9) = "Fruit" Then
            ans = ans + 1
        End If
    Next i

    If ans > 0 Then
        MsgBox 1 / ans
    Else
        MsgBox "Division by 0 error"
    End If
End Sub

此代码将您的范围设置为数组（您需要更改范围以适合您的范围。我建议您将整个已使用的范围放入数组中，以防您想要进行任何其他计算）。然后，如果它与if条件匹配，它将测试数组中的每个条目。然后将其作为计数添加1。