2013-02-21 115 views
5

由於我擁有的數據量太多,我的代碼超慢(每張紙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上包含所有內容,而不是表單1中的所有內容,但我將採取我現在可以獲得的內容。

在尋找解決方案後,似乎互聯網上的每個人都同意使用陣列來加速它。但是,我無法弄清楚如何將這些可愛的建議應用到我當前的代碼中。我意識到有一個很好的可能性,將不得不廢棄這些代碼,並重新開始,但我再次問如何?

+0

由於您是基於一個標準比較值,我認爲您可以使用條件格式來完成這項工作。 – 2013-02-21 17:03:11

回答

6

歡迎來到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 
+0

令人驚歎!我調整了我的數據所在的列,並像魅力一樣工作。這對我來說是一個很好的起點,我想我可以從這裏工作。非常感謝! – user2096018 2013-02-21 20:27:31