Arrays vba-循环中的循环冻结excel

Arrays vba-循环中的循环冻结excel,arrays,vba,excel,Arrays,Vba,Excel,我试图做一个循环,通过一个数组(47193,4)和一个名为攻击的数组2(41892,1)。这里的想法是,攻击数组的值按照我稍后要将值添加到下一列的表的顺序排列,这就是我将值添加到第三个数组的原因。因此,循环将逐个遍历攻击数组中的值,同时通过arr数组查找公共数据。我尝试直接将值复制到工作表中,但excel冻结了很多。现在用这种方法,excel仍然冻结在这一点上。有什么问题吗 Dim arr3() As Variant Dim dee As Long ReDim arr3(UBound(atta

我试图做一个循环,通过一个数组(47193,4)和一个名为攻击的数组2(41892,1)。这里的想法是,攻击数组的值按照我稍后要将值添加到下一列的表的顺序排列,这就是我将值添加到第三个数组的原因。因此,循环将逐个遍历攻击数组中的值,同时通过arr数组查找公共数据。我尝试直接将值复制到工作表中,但excel冻结了很多。现在用这种方法,excel仍然冻结在这一点上。有什么问题吗

Dim arr3() As Variant
Dim dee As Long

ReDim arr3(UBound(attacks, 1), 1)

For k = 0 To UBound(attacks, 1)
   j = 0

   For j = 0 To UBound(arr, 1)

       If attacks(k, 0) = arr(j, 0) And attacks(k, 1) = arr(j, 2) Then
           arr3(dee, 0) = attacks(k, 0)
           arr3(dee, 1) = attacks(k, 1)
           de = dee + 1
       End If

    Next j

Next k

下面是一些显示如何使用字典的代码:

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

注意#个匹配项略有不同-嵌套循环捕获重复的匹配项,但字典只统计唯一的匹配项。您可能需要根据您的用例进行调整。

使用连接键将其中一个数组加载到字典中,然后循环另一个数组,并检查
dictionary.Exists
方法以查找匹配项。这里还有一个输入错误:
de=dee+1
我认为您将数据直接放入工作表是正确的,无论是最终工作表还是复制并粘贴到最终工作表的中间工作表。在这里查看我的答案:,特别是顶部和底部我禁用的部分,然后重新启用屏幕更新和计算。这对解决冰冻问题应该有很大帮助。正是出于这个原因,我用这些命令开始和结束每一艘大型潜艇。
Filled test arrays           0 
Finished nested loop         9.101563     2452 matches
Filled dictionary            0.03125 
Finished dictionary loop     0.0078125    2177 matches