2013-02-21 20 views
5

私の持つコードのデータ量は非常に遅いです(シートごとに10+以上)。私は配列を使ってスピードアップする方法があると信じていますが、どうやってそれをどうやって行くのかは分かりません。私は状況を詳細に説明しようとします。アレイを使用して2枚のシートを比較する

私は、差異を見つけるために比較しようとしている請求書番号、部品番号および販売価格(他の情報の中でも)の2つのワークシートを持っています。私は両方のシートの請求書番号と部品番号の連結を使用して、データの各行に固有の番号を作成しました。私はまた、両方のシートをその番号で手動でソートしました。私は、これらのユニークな#のどれがsheet1上にあり、sheet2上ではなく、その逆であるのかを見たいと思います。 (別の部分は、一致するものをチェックして、販売価格が異なるかどうかを確認することですが、私はそれを簡単に把握できると思います)。目標は、ベンダーによって部分的にまたは完全に払われなかった請求書私の会社。

私は1枚のシートに約10k行のデータを持ち、もう1枚に約11kのデータを持っています。以下は、私がwww.vb-helper.com/howto_excel_compare_lists.htmlで見つけたものから修正したものと、このサイトの同様の質問に対する答えを見ているときのコードです。シートが反転しているほぼ同じ第2のサブがある。私はそれが両方の方法を行うただ1つを書くことが可能であるかどうかわかりません。

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はシート1のシートではなくシート2のすべてをシート1にコピーします。

解決策を探した後、インターネット上の誰もが、スピードを上げるために配列の使用が必要であると考えているようです。しかし、私は現在のコードにその素敵なアドバイスをどのように適用するかを理解できません。私は、このコードを破棄してやり直さなければならない可能性が高いことを認識していますが、やはり私はどのように尋ねていますか?

+0

条件を1つの基準に基づいて比較しているので、条件付き書式を使用してジョブを実行できると思います。 –

答えて

6

ようこそ。素晴らしい質問。この手順を一撃してください。あなたはおそらくそれをちょっと整えるかもしれませんが、それはうまくいくはずであり、はるかに速くなるはずです。

参考のため、this linkを参照してください。

更新:私は10Kと11Kの2つのランダムに生成されたデータセットでこれをテストしました。それは目の瞬きよりも少なかった。私は、私が始めた時を見て見る時間がなかった。

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

関連する問題