Dizileri kullanarak iki sayfayı karşılaştırın

Question

Kodum, sahip olduğum veri miktarı nedeniyle süper yavaş (her sayfa için 10+ dk). Diziler kullanarak onu hızlandırmanın bir yolu olabileceğine inanıyorum, ama nasıl gideceğimi bilmiyorum. Durumu ayrıntılı olarak açıklamaya çalışacağım.

Farklılık bulmak için karşılaştırmaya çalıştığım fatura # s, parça # s ve satış fiyatları (diğer bilgiler arasında) içeren iki çalışma sayfam var. Her bir satır için, fatura # ile her iki sayfadaki # parçasının bir birleşimini kullanarak benzersiz bir sayı oluşturdum. Ayrıca, her iki sayfayı da bu sayıya göre sıralıyorum. Bu benzersiz # lerden hangisinin sheet1 üzerinde olduğunu ve sayfa 2'de değil, tersini bulmak istiyorum. (Bunun bir başka kısmı da, Satış fiyatının farklı olup olmadığını kontrol etmek ve bu fiyatın farklı olup olmadığını kontrol etmek olacaktır. Ancak, bunu kolayca çözebileceğimi düşünüyorum.) Amaç, faturaların kısmen veya tamamen satıcı tarafından kaçırıldığını görmek. ve benim şirketim.

Bir sayfada 10k satırlık veri var ve diğer tarafta 11k tane var. Aşağıda, www.vb-helper.com/howto_excel_compare_lists.html adresinde bulduğum modemi kullanarak ve bu sitedeki benzer sorulara verilen yanıtlara bakarak para birimini kullanıyorum. Yaprakları tersine çeviren neredeyse aynı ikinci bir alt var. Her iki şekilde de yazabilmenin mümkün olup olmadığını bilmiyorum.

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 

Bu küçük veri kümeleri için çalışıyor, ama ben geçmesi yapıyorum satır çok sayıda, sadece sonsuza kadar sürer ve Muhasebeciler hiçbiri kullanmak istiyorum. İdeal olarak, sadece farklılıkları yeşile çevirmek yerine, bunları ayrı bir sayfaya kopyalar, yani: sayfa 3'te sayfa 2'de değil, sayfa 2'de her şey olurdu, ama bu noktada alabileceğim şeyi alacağım. Bir çözüm için etrafa baktıktan sonra, Internet'teki herkesin dizileri hızlandırmak için gerekli olduğunu kabul ediyor gibi görünüyor. Bununla birlikte, bu güzel tavsiyemin mevcut koduma nasıl uygulanacağını anlayamıyorum. Bu kodu atmak ve baştan başlamak için iyi bir olasılık olduğunu anlıyorum, ama yine nasıl diye soruyorum?

Answer 1

SO. Harika soru. Bu prosedürü bir atış yapın. Muhtemelen biraz toparlayabilirsin, ama çalışmalı ve çok daha hızlı olmalı.

Referans için bkz. this link.

Güncelleme: Bunu 10K ve 11K satırlık rastgele oluşturulmuş iki veri kümesinde test ettim. Göz açıp kapayıncaya kadar sürdü. Başladığım zamanı görmek için zamanım bile yoktu.

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