Question

我知道已经有很多关于这个问题的问题，我阅读了很多问题并尝试了一些方法，但由于某种原因，它们似乎没有解决我的问题。因此，我正在寻找另一种解决问题的方法，或者在我实施错误时寻求帮助。

我尝试比较两个不同（很长）工作表中的行，如果特定索引匹配，则需要将特定单元格（始终与当前行相同的列）从一张工作表复制到另一张工作表中。

它基本上看起来像这样更大（放大的例子）：

Dim ArrayOne() as string
Dim ArrayTwo() as string

Redim ArrayOne (1 to AmountOfRowsSheet1)
Redim ArrayTwo (1 to AmountOfRowsSheet2)

For i = 1 to AmountOfRowsSheet1
   ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i

For i = 1 to AmountOfRowsSheet2
   ArrayTwo(i) = Sheet2.Cells(i, ThatColumn)
next i

for i = 1 to 4600
  for j = 1 to 69000

       if ArrayOne(i) Like "*" & ArrayTwo(j) then
         Sheet1.Cells(i, 5).value = Sheet3.Cells(i,10).value
'the line above is repeated about 20 times just with different columns
'so it gets potentially executed 4600*69000*20 times (6348000000)
       end if
    

  next j
next i

For 循环并且一切正常，它也可以正确复制，但是在执行了一定数量的行之后，我的内存不足，所以看起来。在任务管理器中，我可以看到我用过的 ram 每隔几秒钟就打勾一次。有一次，excel 只是显示一个错误，因为缺乏资源，它无法再处理下一次复制。

我试过：

Application.CutCopyMode = False '( at restart of loop)

创建一个空的数据对象并将其放入剪贴板。

以及我发现的一些 user32.dll 修复。

到目前为止没有任何效果。

Mybe 这只是我传递糟糕的价值观的方式，如果是这样，请告诉我一个比这个更好的方法，我真的没有想法。

Answer 1

不是问题的答案，而是：

For i = 1 to AmountOfRowsSheet1
   ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i

试试：

ArrayOne= Range(Cells(1, ThisColumn), Cells(AmountOfRowsSheet1, ThisColumn))

ArrayOne 将是一个二维数组，数据从 (1,1) 开始并递增 (n,1)...

更快地获取数据和类似方法可用于将数组放回工作表 - 也比 for 循环快数英里。

编辑：同样，不是直接回答问题，而是这个：

import random, string

# ---------------------------------------------------------
#This part is just generating random data to compare against each other (and in case of lists 5 & 6, the data on the sheet in Sheets1(i,5) & Sheets3(i,10)
N1 = 6
list2 = []

list5 = []  #This would correspond to existing vals in Sheets(1.cells(i,5)
list6 = []  #and this to Sheets3.cells(i,10)
for i1 in range(0, 4600):
    list2.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N1)))
    list5.append(5)
    list6.append(10)
    
N2 = 12
list3 = []
for i1 in range(0, 69000):
    list3.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N2)))




list2[0] = "$$$$$$"  #Just setting two values so we can check the method works
list3[10] = "$$$$££££££"

# ---------------------------------------------------------

#This part is actually doing what your trying to do in VBA 
list4 = []
ij1 = 0
for j1 in list2:
    found = False
    for j2 in list3:
        if j1 in j2:
            found = True
            break
    if found:
        list4.append(list6[j1])
    else:
        list4.append(list5[j1])
            
    ij1 += 1

您感兴趣的部分会在大约 25 秒内运行。绝对不需要花哨的代码工作。去看看下载anaconda。您可能会更快地将您的两个 excel 文件读入 python，执行操作，然后再次写回，而不是尝试纯粹在 VBA 中执行此操作。

Answer 2

我把你的例子变成了如何使用数组

Option Explicit

Sub Example()
    Dim ArrayOne() As Variant
    Dim ArrayTwo() As Variant
    
    ArrayOne = Sheet1.Columns(1).Value 'read column 1 into array
    ArrayTwo = Sheet2.Columns(2).Value 'read column 2 into array
    
    Dim start
    start = Timer
    
    Dim i As Long
    For i = 1 To 4600

        Dim j As Long
        For j = 1 To 69000
            If ArrayOne(i, 1) Like "*" & ArrayTwo(j, 1) Then
                Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value + 1
            End If
        Next j
        
        Debug.Print i, start, Timer, "Runtime=" & Timer-start

        Stop 'we want to test time of one iteration = 23 seconds
    Next i
End Sub

此示例为 23 循环的一次迭代运行 j 秒（在我的计算机上）。所以这将总共运行 23*4600 秒，大约 30 小时。

因此，您要么剥离需要处理的数据，要么使用 Excel VBA 以外的其他工具来加快处理速度。或者你改变整个方法。

请注意，VBA 仅限于单线程。因此，无论您的 CPU 有多少个内核，VBA 都只会使用一个。这使得它实际上是处理大数据的一个非常糟糕的工具。

实际上你需要摆脱的是对单元格的读/写操作

Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value

每当您访问一个单元格值时，它都会变慢很多。如果没有该行，循环将在 2 而不是 23 秒内运行（总运行时间仍为 2.5 小时）。因此，这个速度可能会更快，但可能不会比 2.5 小时快多少。

如果您无法摆脱多个读/写操作，那么即使在进入循环之前关闭计算 Application.Calculation = xlCalculationManual 也会带来巨大的提升。只是不要忘记在最后将它打开 Application.Calculation = xlCalculationAutomatic。请注意，只有在循环运行时没有需要计算的公式时，才能关闭计算（否则会得到错误的结果）。

我建议尝试像上面那样改进您的实际代码，并像我使用 j 命令那样检查内部 stop 循环的完整运行的运行时间。通过这种方式，您可以通过乘以 4600 轻松计算整个运行时间。

另一种避免内存不足错误的方法

2 个答案: