Question

由于我拥有的数据量，我的代码超级慢（每张10分钟以上）。我相信可能有一种方法可以加速使用数组，但我不知道如何去做。我将尝试详细解释这种情况。

我有两个工作表，其中包含发票＃s，部分＃s和销售价格（以及其他信息），我试图比较以找出差异。我使用两张表上的发票号和部件号的串联为每行数据创建了一个唯一的编号。我也用这个号码手动整理了两张纸。我想找出哪些独特的#s在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上的所有内容都不在工作表1上，但我将采取我现在可以获得的内容。

在寻找解决方案后，似乎互联网上的每个人都同意需要使用数组来加快速度。但是，我无法弄清楚如何将这些可爱的建议应用到我当前的代码中。我意识到很有可能不得不废弃这些代码并重新开始，但我又问怎么样？

Answer 1

欢迎来到SO。好问题。给这个程序一个机会。你可能可以整理一下，但它应该工作并且明显更快。

供参考，请参阅this link。

更新：我在两个随机生成的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

使用数组比较两张纸

1 个答案: