Question

我正在尝试循环遍历一个数组（47193，4）和一个名为Attack（41892,1）的数组2。这里的想法是，攻击数组从我要稍后在工作表中按顺序将值添加到下一列，这就是为什么我将值添加到第三数组的原因。因此，循环将遍历arr数组以查找公共数据，同时将攻击数组中的值逐一进行。我尝试将值直接复制到工作表中，但Excel冻结了很多。现在，以这种方式，excel仍会冻结。有什么问题吗？

int

Answer 1

以下是显示如何使用字典的代码：

Sub Tester()

    Const SZ As Long = 10000 'size of test arrays

    Dim arr1(1 To SZ, 1 To 2)
    Dim arr2(1 To SZ, 1 To 2)
    Dim arr3(1 To SZ, 1 To 2) '<<matches go here
    Dim n As Long, m As Long, i As Long, t, dict, k

    t = Timer
    'fill test arrays with random data
    For n = 1 To SZ
        arr1(n, 1) = CLng(Rnd * 200)
        arr1(n, 2) = CLng(Rnd * 200)
        arr2(n, 1) = CLng(Rnd * 200)
        arr2(n, 2) = CLng(Rnd * 200)
    Next n

    Debug.Print "Filled test arrays", Timer - t
    t = Timer
    'test the nested loop approach
    For n = 1 To SZ
    For m = 1 To SZ
        If arr1(n, 1) = arr2(m, 1) And arr1(n, 2) = arr2(m, 2) Then
            i = i + 1
            arr3(i, 1) = arr1(n, 1)
            arr3(i, 2) = arr1(n, 2)
        End If
    Next m
    Next n

    Debug.Print "Finished nested loop", Timer - t, i & " matches"
    t = Timer

    'create a lookup using a dictionary
    Set dict = CreateObject("scripting.dictionary")
    For n = 1 To SZ
        k = arr1(n, 1) & "|" & arr1(n, 2)
        dict(k) = dict(k) + 1
    Next n
    Debug.Print "Filled dictionary", Timer - t
    t = Timer

    i = 0
    Erase arr3

    'Perform the match against arr2 using the dictionary
    For m = 1 To SZ
        k = arr2(m, 1) & "|" & arr2(m, 2)
        If dict.exists(k) Then
            i = i + 1
            arr3(i, 1) = arr2(m, 1)
            arr3(i, 2) = arr2(m, 2)
        End If
    Next m

    Debug.Print "Finished dictionary loop", Timer - t, i & " matches"

End Sub

输出：

Filled test arrays           0 
Finished nested loop         9.101563     2452 matches
Filled dictionary            0.03125 
Finished dictionary loop     0.0078125    2177 matches

请注意，匹配项的数量略有不同-嵌套循环捕获重复的匹配项，但是字典仅计算 unique 匹配项。您可能需要根据使用情况进行调整。

VBA-循环内的循环冻结Excel

1 个答案: