使用数组比较两个表格

Question

使用数组比较两个表格

arraysexcelcompareexcel-2010vba

7

我的代码非常缓慢（每个表格需要10分钟以上），这是由于我拥有大量的数据。我相信可以通过使用数组来加速，但我不确定如何操作。我将尽力详细解释情况。

我有两个工作表，其中包含发票号码、零件号码和销售价格等信息，我正在尝试比较它们以查找差异。我使用发票＃和零件＃的串联为每行数据创建了一个唯一编号，并在两个工作表上手动排序了这个编号。我想找出哪些唯一编号在sheet1上而不在sheet2上，反之亦然。（另一部分是检查匹配的编号并查看销售价格是否不同，但我认为我可以很容易地解决这个问题。）目标是查看供应商和我们公司错过了哪些发票，无论是部分还是全部。

我在一个表格中有大约10k行数据，在另一个表格中有11k行数据。下面是我目前使用的代码，修改自www.vb-helper.com/howto_excel_compare_lists.html，并查看了本网站类似问题的答案。几乎有一个完全相同的第二个子程序，工作表被颠倒了。我不知道是否可能编写只执行双向操作的代码。

Private Sub cmdCompare2to1_Click()
Dim first_index As Integer
Dim last_index As Integer
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim r1 As Integer
Dim r2 As Integer
Dim found As Boolean

Set sheet1 = Worksheets(1)
Set sheet2 = Worksheets(2)

Application.ScreenUpdating = False

first_index = 1
last_index = sheet1.Range("a" & Rows.Count).End(xlUp).Row

' For each entry in the second worksheet, see if it's
' in the first.
For r2 = first_index To last_index
    found = False
    ' See if the r1-th entry on sheet 2 is in the sheet
    ' 1 list.
    For r1 = first_index To last_index
        If sheet1.Cells(r1, 16) = sheet2.Cells(r2, 9) Then
        ' We found a match.
            found = True
            Exit For
        End If
    Next r1

    ' See if we found it.
    If Not found Then
        ' Flag this cell.
        sheet2.Cells(r2, 9).Interior.ColorIndex = 35
        End If
Next r2

Application.ScreenUpdating = True

End Sub

它在处理小数据集时表现良好，但是对于我要处理的大量行，它需要花费很长时间，而且会让所有的会计师都不想使用它。理想情况下，它不仅可以将差异变成绿色，还可以将其复制到一个单独的工作表中，即：工作表3将拥有工作表2中没有的所有内容，但目前我所能得到的只有这些。

在寻找解决方案后，似乎互联网上的每个人都认为需要使用数组来加速。然而，我无法想象如何将这个可爱的建议应用到我的当前代码中。我意识到很可能必须放弃这段代码并重新开始，但我再次问怎么做？

- user2096018

由于您是基于一个条件比较值，我认为您可以使用条件格式来完成这项工作。 - kb_sou

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Scott Holtzman · Accepted Answer

欢迎来到SO。好问题。请尝试这个步骤。你可能需要稍微整理一下它，但它应该能够正常工作并且速度明显更快。

参考链接，请查看此链接。

更新：我在两个随机生成的数据集上进行了测试，分别包含10K和11K行。它只花了一眨眼的时间。我甚至没有时间查看我开始的时间。

Option Explicit

Private Sub cmdCompare2to1_Click()

Dim sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet
Dim lngLastR As Long, lngCnt As Long
Dim var1 As Variant, var2 As Variant, x
Dim rng1 As Range, rng2 As Range


Set sheet1 = Worksheets(1)
Set sheet2 = Worksheets(2)
Set sheet3 = Worksheets(3) ' assumes sheet3 is a blank sheet in your workbook

Application.ScreenUpdating = False

'let's get everything all set up
'sheet3 column headers
sheet3.Range("A1:B1").Value = Array("in1Not2", "in2Not1")

'sheet1 range and fill array
With sheet1

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row

    Set rng1 = .Range("A1:A" & lngLastR)
    var1 = rng1

End With

'sheet2 range and fill array
With sheet2

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row

    Set rng2 = .Range("A1:A" & lngLastR)
    var2 = rng2

End With

'first check sheet1 against sheet2
On Error GoTo NoMatch1
For lngCnt = 1 To UBound(var1)

    x = Application.WorksheetFunction.Match(var1(lngCnt, 1), rng2, False)

Next


'now check sheet2 against sheet1
On Error GoTo NoMatch2
For lngCnt = 1 To UBound(var2)

    x = Application.WorksheetFunction.Match(var2(lngCnt, 1), rng1, False)

Next

On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

NoMatch1:
    sheet3.Range("A" & sheet3.Rows.Count).End(xlUp).Offset(1) = var1(lngCnt, 1)
    Resume Next


NoMatch2:
    sheet3.Range("B" & sheet3.Rows.Count).End(xlUp).Offset(1) = var2(lngCnt, 1)
    Resume Next


End Sub