वीबीए मैक्रो 32000 पंक्तियों के बाद दुर्घटनाग्रस्त

Question

मेरे पास एक वीबीए मैक्रो है जो 3 वर्कशीट में कोशिकाओं में मानों को ढूंढने के आधार पर एक वर्कशीट से पंक्तियों की प्रतिलिपि बनाता है। मैक्रो काम करता है, लेकिन यह पंक्ति 32767 तक पहुंचने पर दुर्घटनाग्रस्त हो जाता है। इस पंक्ति में कोई सूत्र या विशेष स्वरूपण नहीं है। इसके अलावा, मैंने उस पंक्ति को बाहर निकाला है, लेकिन यह अभी भी उस पंक्ति संख्या पर दुर्घटनाग्रस्त हो गया है। क्या यह एक्सेल में एक सीमा है? वहाँ वर्कशीट में कुछ 43,000 है कि इस प्रक्रिया

इसलिए किया जा रहा है कर रहे हैं, मैं पूछता हूँ कि मेरी मैक्रो के साथ गलत है और मैं कैसे प्राप्त कर सकते हैं यह वर्कशीट के अंत तक पहुँचते:

Dim LSearchRow As Integer 
Dim LCopyToRow As Integer 
Dim wks As Worksheet 
On Error GoTo Err_Execute 

कार्यपत्रक में प्रत्येक सप्त लिए

LSearchRow = 4 
LCopyToRow = 4 

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
Set wksCopyTo = ActiveSheet 
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3) 

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0 

    If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then 

     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Copy 


     wksCopyTo.Select 
     wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
     wksCopyTo.Paste 

     'Move counter to next row 
     LCopyToRow = LCopyToRow + 1 
     'Go back to Sheet1 to continue searching 
     wks.Select 
    End If 
    LSearchRow = LSearchRow + 1 
Wend 

Application.CutCopyMode = False 
Range("A3").Select 
MsgBox "All matching data has been copied." 
Next wks 
    Exit Sub 
Err_Execute: 
    MsgBox "An error occurred." 

कृपया मदद करें!

Answer 1

वीबीए 'इंट' प्रकार एक हस्ताक्षरित 16-बिट फ़ील्ड है, इसलिए यह केवल -32768 से +32767 तक मान रख सकता है। उन चर को 'लांग' में बदलें, जो एक हस्ताक्षरित 32-बिट फ़ील्ड है और -2147483648 से +2147483647 तक मान रख सकता है। एक्सेल के लिए पर्याप्त होना चाहिए। ;)

Answer 2

यह एक पूर्णांक समस्या

पूर्णांक और लांग डेटा प्रकार दोनों सकारात्मक या नकारात्मक मान हो सकते हैं जैसा लगता है। उनके बीच का अंतर उनके आकार का है: इंटीजर वैरिएबल -32,768 और 32,767 के बीच मान रख सकता है, जबकि लंबी चर 2,147,483,648 से 2,147,483,647 तक हो सकती है।

लेकिन आप किस संस्करण का उपयोग कर रहे हैं? क्योंकि:

परंपरागत रूप से, VBA प्रोग्रामर पूर्णांकों का इस्तेमाल किया है, कम संख्या धारण करने के लिए, क्योंकि वे कम स्मृति की आवश्यकता है। हाल के संस्करणों में, हालांकि, वीबीए सभी पूर्णांक टाइप करने के लिए पूर्णांक मानों को परिवर्तित करता है, भले ही उन्हें इंटीजर के रूप में घोषित किया गया हो। इसलिए, इंटीजर चर का उपयोग कर पर अब प्रदर्शन का लाभ नहीं है; वास्तव में, लंबे चर कुछ तेज हो सकते हैं क्योंकि वीबीए को उन्हें परिवर्तित करने की आवश्यकता नहीं है।

यह सूचना MSDN

अद्यतन से सीधे है

कृपया यह भी पहली टिप्पणी पढ़ें! मैं एमएसडीएन सूचना को गलत तरीके से व्याख्या कर रहा था!

एमएसडीएन भ्रामक होने की बात करता है: वीबीए स्वयं को इंटीजर को लांग में परिवर्तित नहीं करता है। कवर के तहत सीपीयू पूर्णांक को लंबे समय तक परिवर्तित करता है, अंकगणित करता है और फिर परिणामस्वरूप लंबे समय तक पूर्णांक में परिवर्तित होता है। Charles Williams

Answer 3

आप के बजाय प्रत्येक के लिए एक का उपयोग कर पंक्तियों incrementing द्वारा पूर्णांक बनाम लांग समस्या से बचने कर सकते हैं - तो VBA पूर्णांकों अभी भी संख्या 32K से बड़ा नहीं हो सकते। प्रत्येक के लिए आम तौर पर तेज़ होता है, क्योंकि रेंज चुनने से बचा जाता है।यहां एक उदाहरण दिया गया है:

Sub CopySheets() 

    Dim shSource As Worksheet 
    Dim shDest As Worksheet 
    Dim rCell As Range 
    Dim aSheets() As Worksheet 
    Dim lShtCnt As Long 
    Dim i As Long 

    Const sDESTPREFIX As String = "dest_" 

    On Error GoTo Err_Execute 

    For Each shSource In ThisWorkbook.Worksheets 
     lShtCnt = lShtCnt + 1 
     ReDim Preserve aSheets(1 To lShtCnt) 
     Set aSheets(lShtCnt) = shSource 
    Next shSource 

    For i = LBound(aSheets) To UBound(aSheets) 
     Set shSource = aSheets(i) 

     'Add a new sheet 
     With ThisWorkbook 
      Set shDest = .Worksheets.Add(, .Worksheets(.Worksheets.Count)) 
      shDest.Name = sDESTPREFIX & shSource.Name 
     End With 

     'copy header row 
     shSource.Rows(3).Copy shDest.Rows(3) 

     'loop through the cells in column a 
     For Each rCell In shSource.Range("A4", shSource.Cells(shSource.Rows.Count, 1).End(xlUp)).Cells 
      If Not IsEmpty(rCell.Value) And _ 
       rCell.Offset(0, 27).Value = "Yes" And _ 
       rCell.Offset(0, 36).Value = "Yes" And _ 
       rCell.Offset(0, 53).Value = "Yes" Then 

       'copy the row 
       rCell.EntireRow.Copy shDest.Range(rCell.Address).EntireRow 
      End If 
     Next rCell 
    Next i 

    MsgBox "All matching data has been copied." 

Err_Exit: 
    'do this stuff even if an error occurs 
    On Error Resume Next 
    Application.CutCopyMode = False 
    Exit Sub 

Err_Execute: 
    MsgBox "An error occurred." 
    Resume Err_Exit 

End Sub