6

由于我拥有的数据量，我的代码非常慢（每张纸 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 上，但我会采取我现在能得到的。

在四处寻找解决方案后，似乎互联网上的每个人都同意需要使用数组来加快速度。但是，我不知道如何将这些可爱的建议应用到我当前的代码中。我意识到很有可能必须废弃此代码并重新开始，但我再次问如何？

4

1 回答 1

7

欢迎来到 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
于 2013-02-21T17:01:42.677 回答