vba - VBA 宏加速

Question

对于以下 VBA 宏问题，我将不胜感激，截图如下：

我必须比较 2 列中的数据 - 索引和 Sec_Index。在匹配的情况下，它应该检查哪些值被分配给了 Sec_Index 并为与索引对应的匹配值列填充“1”，为其他值列填充“0”（我希望屏幕截图能更好地解释它）

我写了一个简短的宏，效果很好。但是我有大量数据 - 两个索引列都至少包含 400000-500000 行。这使我的代码毫无用处，因为它需要很长时间才能执行。

有没有办法使这项工作？我阅读了有关 Variant 数组的信息，但我对它们并不熟悉。

Answer 1

你可以把这个公式（如果 Excel 2007 或更高版本）：

=COUNTIFS($H$2:$H$5,$B2,$I$2:$I$5,"A")

进入C2并将其向下复制；只需将“A”更改为“B”和“C”。

添加鉴于行数，我会将数据导入 MS Access，创建交叉表查询，然后将此数据复制回 Excel。

Answer 2

试试这个，不是太健壮但确实有效。不确定这与您可能拥有的相比有多快？

它使用了大约60,000行。25 keys5 seconds

编辑：添加了计时器功能。

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
public Sub main()
Dim t As Long
t = GetTickCount
    Application.ScreenUpdating = False
    Dim Arr1(), Arr() As Double
    Dim x, y, i, j As Double
    Dim v As String
    x = Cells(Rows.Count, 2).End(xlUp).Row - 2
    y = Cells(Rows.Count, 8).End(xlUp).Row - 2
    Range("c2", "e" & x + 2) = 0
    ReDim Arr1(x)
    ReDim Arr2(y)
    i = 0
    Do Until Cells(i + 2, 2) = ""
        Arr1(i) = Cells(i + 2, 2)
        i = i + 1
    Loop
    i = 0
    Do Until Cells(i + 2, 8) = ""
        Arr2(i) = Cells(i + 2, 2)
        i = i + 1
    Loop
    i = 0
    Do Until i > UBound(Arr1)
        j = 0
        Do Until j > UBound(Arr2)
            If Arr1(i) = Arr2(j) Then
                v = Cells(Arr2(j) + 1, 9)
                Select Case v
                    Case "a"
                        Cells(i + 2, 3) = 1
                    Case "b"
                        Cells(i + 2, 4) = 1
                    Case "c"
                        Cells(i + 2, 5) = 1
                End Select
                Exit Do
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop
    MsgBox GetTickCount - t, , "Milliseconds"
End Sub