सरणी

Question

का उपयोग करके दो चादरों की तुलना करें मेरे पास डेटा की मात्रा के कारण मेरा कोड बहुत धीमा है (प्रत्येक शीट के लिए 10+ मिनट)। मेरा मानना ​​है कि सरणी का उपयोग करके इसे गति देने का एक तरीका हो सकता है, लेकिन मुझे यकीन नहीं है कि इसके बारे में कैसे जाना है। मैं स्थिति को विस्तार से समझाने की कोशिश करूंगा।

मेरे पास चालान # एस, भाग # एस और बिक्री की कीमतों (अन्य जानकारी के साथ) के साथ दो कार्यपत्रक हैं जिन्हें मैं अंतर खोजने के लिए तुलना करने की कोशिश कर रहा हूं। मैंने इनवॉइस # और दोनों चादरों पर भाग # के संयोजन का उपयोग करके डेटा की प्रत्येक पंक्ति के लिए एक अद्वितीय संख्या बनाई है। मैंने उस संख्या से मैन्युअल रूप से दोनों चादरों को भी क्रमबद्ध किया है। मैं यह जानना चाहता हूं कि इनमें से कौन सा अद्वितीय # एस शीट 1 पर है और शीट 2 पर नहीं है और इसके विपरीत। (इसका एक और हिस्सा उन लोगों की जांच करना होगा जो मैच करते हैं और देखते हैं कि बिक्री मूल्य अलग है या नहीं, लेकिन मुझे लगता है कि मैं इसे आसानी से समझ सकता हूं।) लक्ष्य यह देखना है कि चालक द्वारा आंशिक रूप से या पूरी तरह से चालान को किस तरह याद किया गया था और मेरी कंपनी।

मेरे पास एक शीट में डेटा की लगभग 10k पंक्तियां और दूसरे में 11k है। नीचे कोड है जो मैंने www.vb-helper.com/howto_excel_compare_lists.html पर जो पाया है उससे संशोधित का उपयोग करके और इस साइट पर समान प्रश्नों के उत्तर देखने से मैं currenlty हूँ। चादरों के उलट के साथ लगभग समान दूसरा उप है। मुझे नहीं पता कि सिर्फ एक ही लिखना संभव है जो दोनों तरीकों से करता है।

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 पर शीट 2 पर सब कुछ नहीं होगा, लेकिन मैं इस बिंदु पर जो प्राप्त कर सकता हूं उसे ले जाऊंगा।

समाधान के लिए चारों ओर देखने के बाद, ऐसा लगता है कि इंटरनेट पर हर कोई इस बात से सहमत है कि इसे तेज करने के लिए सरणी के उपयोग की आवश्यकता है। हालांकि, मैं यह नहीं समझ सकता कि मेरे वर्तमान कोड को उस प्यारी सलाह को कैसे लागू किया जाए। मुझे एहसास है कि एक अच्छी संभावना है कि इस कोड को स्क्रैप करना और शुरू करना होगा, लेकिन फिर मैं पूछता हूं कि कैसे?

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