VBA 2010：关于加速循环的编码实践的建议

Question

我在一段脚本中有一个循环，它运行非常缓慢。我希望得到一些关于改进这一点的建议。

我有 8 对数据集。每对由一个数组（一维，通常包含 400 个字符串元素）和一个通常包含大约 2000 个字符串元素的列组成。在每对数据集中，我想检查数组的每个元素与列的每个元素是否匹配。这是我的方法的简化版本：

For i = 1 to 8
    For j = 0 to 400
        For k = 0 to 2000
           If Cells(k,i) = myArray[1, then 2, then 3, etc.](j) then [action]
        next K
    next j
next i

通过执行上述操作，我将循环 A 列的前 2000 个单元格 400 次，然后循环 B 列的前 2000 个单元格 400 次，依此类推。这似乎非常多余，检查了大约 640 万个单元，这需要很长时间。我希望有更好的方法来做到这一点，并希望有人能启发我。

如有必要，我可以向您展示实际代码并解释它所做的所有事情，但它有点冗长。

编辑：这是实际代码。它正在寻找也具有合格布尔值的骗子。当满足这些条件时，它会采用它们相关的整数值和行号。它将所有整数值相加，并用它们的总和替换这些整数。它对每个唯一名称执行此操作，然后（未显示）对其余 7 个数据集重复此操作。

    For i = 0 To j - 1 'starts with the first unique element and searches for dupes...
        v = 0 'initial qty value 
        r = 0 'initial number of rows with dupes
        For k = 2 To WULastRow 'go though each cell in the first column
            If Cells(k, colPair + 2) = True And Cells(k, colPair).Text = uniqueNames(i) Then '...if one is found and the row's boolean is true...
                v = v + Cells(k, colPair + 1).Value '...sum it's qty with previous dupes qty's...
                r = r + 1 'increment number of dupes found
                ReDim Preserve rngMatch(r - 1) 'increase the size of the array that will hold the row numbers of the dupes.
                rngMatch(r - 1) = k '...and input dupe's row number to said array.
            End If
        Next k

        k = 0

        'if 1 or more duplicate is found for the given unique item name is found...
        If r > 1 Then
            k = 0
            For k = 0 To r - 1
                Cells(rngMatch(k), colPair + 1).Value = v '...input the summed quantity in their qty cells...
            Next k
        End If
    Next i 'then regardless, move on to the name unique name and repeat this process.

Answer 1

每次访问 Cell(i,j) 都会有很大的开销

您需要通过使用单个语句将数据获取到变体数组中来避免这种情况，然后循环该数组，然后如果需要将其放回：这里是一些演示代码

Option Base 1
dim vArr as variant
varr=Range("A1").resize(Lastrow,LastCol).Value2
for j=1 to LastRow
for k=1 to LastCol
if vArr(j,k) .... then Varr(j,k)= ...
next k
next j
Range("A1").resize(Lastrow,LastCol)=Varr

Answer 2

您需要做的是实现某种变量排序启发式算法来对矩阵中的元素进行排序（从最低到最高等）。下面是一个帮助您入门的示例：

如果我有一个数组a = [1,8,16]（从最少到最多排序）和另一个数组b = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]（再次排序），我可以引入一个规则，即每次搜索迭代都发生在最后一次搜索的结束位置。这是我的意思的一些伪：

index = 0
for i in a:
   for j in range(index, len(b)):
      if a == b:
          do something
          index = j

这实际上是允许您在每次匹配一个值时迭代地搜索越来越小的空间。希望这是有道理的 - 将可变排序排名应用于您的 b 矩阵可能很困难。