64K+ ListRows (स्मृति से बाहर) के साथ प्रत्येक लूप के लिए VBA

Question

मैं एक एक्सेल टेबल (लिस्टोबजेक्ट) के माध्यम से एक वीबीए for each लूप चला रहा हूं जो जांचता है कि किसी दिए गए पथ के आधार पर कोई फ़ाइल मौजूद है या नहीं। हालांकि मेरी तालिका का विस्तार हुआ है और इसमें 68K लिस्ट्रो हैं। कोड लॉन्च करने के बाद, यह जल्दी से एक त्रुटि देता है Run-time-error '7': Out of memory

यह 63 के लाइनों (5 मिनट के भीतर किया गया) के साथ ठीक चलता है और गुगलिंग के आधार पर "64 के सेगमेंट सीमा" नामक कुछ प्रतीत होता है। क्या यह मेरे कोड को चलाने के लिए प्रभावित कर रहा है क्योंकि यह वास्तव में ऐसा लगता है कि यह पहली बार पंक्ति गणना को बफर करता है और फिर वास्तव में कुछ भी चलाने के लिए शुरू होता है। क्या मेरे डेटासेट को कई बैचों में विभाजित करने की आवश्यकता के बिना इसके लिए कोई आसान समाधान है? सच कहूं, तो मैं काफी हैरान था कि 2021 में एक्सेल में 64K की सीमा अभी भी एक चीज होगी।

इसे 64 बिट एक्सेल 2019 पर चलाना, लेकिन Office365 के साथ भी कोई भाग्य नहीं।

Sub CheckFiles()

Dim Headers As ListObject
Dim lstrw As ListRow

Dim strFileName As String
Dim strFileExists As String

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Import")
Set Headers = ws.ListObjects("Import")

    For Each lstrw In Headers.ListRows
    
        strFileName = lstrw.Range(7)
        strFileExists = Dir(strFileName)
        
        If strFileExists = "" Then
        lstrw.Range(4) = "not found"
        Else
        lstrw.Range(4) = "exists"
        End If
    
    Next lstrw

Set ws = Nothing
Set Headers = Nothing

Application.ScreenUpdating = True

End Sub

excel vba foreach

2

sql scholar 21 अप्रैल 2021, 18:08

Answer 1

वर्कशीट तक पहुँचने से बचें

चूंकि आप लूपिंग से बच नहीं सकते हैं, आप इसे कंप्यूटर की मेमोरी में बेहतर तरीके से करते हैं, यानी किसी श्रेणी के सेल के बजाय किसी सरणी के तत्वों के माध्यम से।
कोड अभी भी धीमा है, मेरी मशीन पर 200k पंक्तियों के लिए लगभग 10s, लेकिन यह Dir के कारण है।
ध्यान दें कि यह कितना आसान है (केवल एक पंक्ति, जब श्रेणी में एक से अधिक सेल होते हैं) और एक सरणी (Data = rg.Value) में एक श्रेणी लिखना (प्रतिलिपि बनाना) कितना तेज़ (एक विभाजित सेकंड) है और लिखना (प्रतिलिपि बनाना) है एक श्रेणी में वापस सरणी (rg.Value = Data)।
स्थिरांक अनुभाग में मानों को समायोजित करें।

Option Explicit

Sub CheckFiles()

    Const wsName As String = "Import" ' Worksheet Name
    Const tblName As String = "Import" ' Table Name
    Const cCol As Long = 7 ' Criteria Column
    Const dCol As Long = 4 ' Destination Column

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim Headers As ListObject: Set Headers = ws.ListObjects(tblName)

    Dim Data As Variant ' Data Array
    With Headers.ListColumns(cCol).DataBodyRange
        If .Rows.Count = 1 Then
            ReDim Data(1 To 1, 1 To 1): Data = .Value
        Else
            Data = .Value
        End If
    End With
    
    Dim r As Long ' Array Row Counter (DataBodyRange Row Counter)
    Dim FileName As String ' File Name Retrieved by Dir
    
    For r = 1 To UBound(Data, 1)
        FileName = Dir(CStr(Data(r, 1)))
        If Len(FileName) = 0 Then
            Data(r, 1) = "not found"
        Else
            Data(r, 1) = "exists"
        End If
    Next r
    
    Headers.ListColumns(dCol).DataBodyRange.Value = Data

End Sub

2

VBasic2008 21 अप्रैल 2021, 20:59

Answer 2

आप सभी को धन्यवाद! कुछ टेकअवे। स्पष्ट रूप से यथासंभव कुशल कोड लिखने की कोशिश करते हुए, यहां कोई भी उचित प्रदर्शन स्वीकार्य है। इसके साथ ही, for each लूप ने 63K लाइनों के साथ चलने में लगभग 5 मिनट का समय लिया, जबकि यह लगभग 15 सेकंड में उस कोड द्वारा किया गया था जिसे मैंने @ VBasic2008 द्वारा उत्तर के रूप में स्वीकार किया था - बिना क्षमता की समस्याओं के भी।

इस विशेष कोड के साथ मेरी एकमात्र समस्या यह थी कि यह मेरे लिए कुछ नया दृष्टिकोण था, इसलिए संभवतः भविष्य में इस पर निर्माण करने के लिए इसमें गहराई से देखने के लिए कुछ समर्पण की आवश्यकता है - लेकिन यह निश्चित रूप से कुशल दिखता है। मैंने एक नियमित for ... to लूप भी एक साथ रखा जो 68K लाइनों के साथ समस्याओं में नहीं चलता था और offset फ़ंक्शन के साथ पंक्तियों और स्तंभों के बीच चलता था।

स्पष्ट रूप से for each से तेज @Pᴇʜ के रूप में सुझाव दिया लेकिन सरणी विधि (30 सेकंड या तो) के रूप में लगभग 2x लंबा लगा।

Sub CheckFiles_2()

Dim strFileName, strFileExists As String
Dim ws As Worksheet

Dim Headers As ListObject
Dim result As String
Dim counter, RowCount As Long

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("Import")
Set Headers = ws.ListObjects("Import")

RowCount = Headers.ListRows.Count

For counter = 1 To RowCount

strFileName = Range("anchorCell").Offset(counter, 3)

        strFileExists = Dir(strFileName)
        
        If strFileExists = "" Then
        result = "not found"
        Else
        result = "exists"
        End If

Range("anchorCell").Offset(counter, 0) = result

Next counter

Set ws = Nothing
Set Headers = Nothing

Application.ScreenUpdating = True

End Sub

1

sql scholar 22 अप्रैल 2021, 00:06

64K+ ListRows (स्मृति से बाहर) के साथ प्रत्येक लूप के लिए VBA

2 जवाब

वर्कशीट तक पहुँचने से बचें

संबंधित सवाल

नए सवाल

excel