दिलचस्प पोस्ट
जाने में लाइन द्वारा फ़ाइल लाइन पढ़ना फ़ील्ड के डिफ़ॉल्ट मूल्य का चयन कैसे करें कैसे एक वेबसाइट है कि पायथन के साथ पहले प्रवेश की आवश्यकता है परिमार्जन करने के लिए पायथन में एक सूची का अंतिम तत्व प्राप्त करना ASP.NET MVC यूआरएल रूट का समर्थन (डॉट) नियंत्रक को @ एचटीएमएल एक्शनलिंक एमवीसी 4 से नियंत्रक पास करें सीएसएस में अधिकतम वर्ण की लंबाई निर्धारित करना तेजी से ध्वनि बनाना और खेलना PHP conditionals, कोष्ठक की जरूरत है? C ++ std :: pair का सी # एनालॉग क्या है? रेल: क्लाइंट आईपी पता प्राप्त करें शुद्ध PHP में HTTP पुनर्निर्देशन के बाद अंतिम URL कैसे प्राप्त करें? DialogFragment से परिणाम प्राप्त करें बाश कमांड लाइन तक पहुंच $ $ बनाम $ $ jQuery: बिना टैग के सीधे पाठ प्राप्त करने के लिए (HTML में)

एक्सेल वीबीए प्रदर्शन – 1 मिलियन पंक्तियाँ – 1 मिनट से कम में मूल्य युक्त पंक्तियों को हटाएं

मैं बड़े डेटा को फ़िल्टर करने और एक कार्यपत्रक में पंक्तियां निकालने का एक रास्ता खोजने का प्रयास कर रहा हूं, एक मिनट से भी कम समय में

लक्ष्य:

  • कॉलम 1 में विशिष्ट टेक्स्ट वाले सभी रिकॉर्ड्स ढूंढें, और पूरे पंक्ति को हटा दें
  • सभी सेल फ़ॉर्मेटिंग (रंग, फ़ॉन्ट, बॉर्डर, कॉलम की चौड़ाई) और सूत्रों को उनके रूप में रखें

परीक्षण डेटा:

परीक्षण डेटा :

कोड कैसे काम करता है:

  1. यह सभी एक्सेल विशेषताओं को बंद करके शुरू होता है
  2. यदि कार्यपुस्तिका खाली नहीं है और पाठ मूल्य को हटाया जाना है तो स्तंभ 1 में मौजूद है

    • एक सरणी के लिए कॉलम 1 की प्रयुक्त श्रेणी की प्रतियां
    • पीछे की ओर सरणी में हर मूल्य पर बदलता है
    • जब यह एक मैच पाता है:

      • "A11,A275,A3900,..." प्रारूप में सेल एड्रेस को एक "A11,A275,A3900,..." स्ट्रिंग में "A11,A275,A3900,..."
      • यदि tmp चर लंबाई 255 वर्णों के करीब है
      • पंक्तियों का उपयोग करके पंक्तियों को हटाता है। .Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp
      • रिक्त करने के लिए टीएमपी को रीसेट करता है और पंक्तियों के अगले सेट पर चलता रहता है
  3. अंत में, यह सभी एक्सेल सुविधाओं को वापस चालू करता है

मुख्य मुद्दा हटाना ऑपरेशन है , और कुल अवधि का समय एक मिनट से कम होना चाहिए। कोई कोड-आधारित समाधान स्वीकार्य है जब तक कि यह 1 मिनट से कम होता है।

इससे गुंजाइश को बहुत कम स्वीकार्य उत्तर मिलते हैं पहले से प्रदान किए गए उत्तर भी बहुत ही कम और लागू करने में आसान हैं। एक के बारे में 30 सेकंड में ऑपरेशन करता है, इसलिए कम से कम एक जवाब है जो स्वीकार्य समाधान प्रदान करता है, और अन्य इसे उपयोगी भी पा सकते हैं

मेरा मुख्य प्रारंभिक कार्य:

 Sub DeleteRowsWithValuesStrings() Const MAX_SZ As Byte = 240 Dim i As Long, j As Long, t As Double, ws As Worksheet Dim memArr As Variant, max As Long, tmp As String Set ws = Worksheets(1) max = GetMaxCell(ws.UsedRange).Row FastWB True: t = Timer With ws If max > 1 Then If IndexOfValInRowOrCol("Test String", , ws.UsedRange) > 0 Then memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2 For i = max To 1 Step -1 If memArr(i, 1) = "Test String" Then tmp = tmp & "A" & i & "," If Len(tmp) > MAX_SZ Then .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp tmp = vbNullString End If End If Next If Len(tmp) > 0 Then .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp End If .Calculate End If End If End With FastWB False: InputBox "Duration: ", "Duration", Timer - t End Sub 

हेल्पर फ़ंक्शंस (एक्सल फीचर बंद और चालू):

 Public Sub FastWB(Optional ByVal opt As Boolean = True) With Application .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic) .DisplayAlerts = Not opt .DisplayStatusBar = Not opt .EnableAnimations = Not opt .EnableEvents = Not opt .ScreenUpdating = Not opt End With FastWS , opt End Sub Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _ Optional ByVal opt As Boolean = True) If ws Is Nothing Then For Each ws In Application.ActiveWorkbook.Sheets EnableWS ws, opt Next Else EnableWS ws, opt End If End Sub Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean) With ws .DisplayPageBreaks = False .EnableCalculation = Not opt .EnableFormatConditionsCalculation = Not opt .EnablePivotTable = Not opt End With End Sub 

डेटा के साथ अंतिम सेल मिल जाता है (धन्यवाद @ ज़ीजीडी – अब मैंने कई परिदृश्यों में इसका परीक्षण किया है):

 Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range 'Returns the last cell containing a value, or A1 if Worksheet is empty Const NONEMPTY As String = "*" Dim lRow As Range, lCol As Range If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange If WorksheetFunction.CountA(rng) = 0 Then Set GetMaxCell = rng.Parent.Cells(1, 1) Else With rng Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _ After:=.Cells(1, 1), _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows) If Not lRow Is Nothing Then Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _ After:=.Cells(1, 1), _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByColumns) Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column) End If End With End If End Function 

किसी मेल के इंडेक्स को सरणी में, या 0 मिलता है यदि कोई मैच नहीं मिला है:

 Public Function IndexOfValInRowOrCol( _ ByVal searchVal As String, _ Optional ByRef ws As Worksheet = Nothing, _ Optional ByRef rng As Range = Nothing, _ Optional ByRef vertical As Boolean = True, _ Optional ByRef rowOrColNum As Long = 1 _ ) As Long 'Returns position in Row or Column, or 0 if no matches found Dim usedRng As Range, result As Variant, searchRow As Long, searchCol As Long result = CVErr(9999) '- generate custom error Set usedRng = GetUsedRng(ws, rng) If Not usedRng Is Nothing Then If rowOrColNum < 1 Then rowOrColNum = 1 With Application If vertical Then result = .Match(searchVal, rng.Columns(rowOrColNum), 0) Else result = .Match(searchVal, rng.Rows(rowOrColNum), 0) End If End With End If If IsError(result) Then IndexOfValInRowOrCol = 0 Else IndexOfValInRowOrCol = result End Function 

अद्यतन करें:

6 समाधान (3 परीक्षण प्रत्येक) का परीक्षण किया गया: एक्सेल हीरो का समाधान अब तक का सबसे तेज है (सूत्रों को हटाता है)

यहां दिए गए परिणाम, सबसे तेज़ सबसे तेज़ हैं:

टेस्ट 1. कुल 100,000 रिकॉर्ड, 10,000 हटाए जाएंगे:

 1. ExcelHero() - 1.5 seconds 2. DeleteRowsWithValuesNewSheet() - 2.4 seconds 3. DeleteRowsWithValuesStrings() - 2.45 minutes 4. DeleteRowsWithValuesArray() - 2.45 minutes 5. QuickAndEasy() - 3.25 minutes 6. DeleteRowsWithValuesUnion() - Stopped after 5 minutes 

टेस्ट 2. कुल 1 मिलियन रिकॉर्ड, 100,000 हटाए जाएंगे:

 1. ExcelHero() - 16 seconds (average) 2. DeleteRowsWithValuesNewSheet() - 33 seconds (average) 3. DeleteRowsWithValuesStrings() - 4 hrs 38 min (16701.375 sec) 4. DeleteRowsWithValuesArray() - 4 hrs 37 min (16626.3051757813 sec) 5. QuickAndEasy() - 5 hrs 40 min (20434.2104492188 sec) 6. DeleteRowsWithValuesUnion() - N/A 

टिप्पणियाँ:

  1. ExcelHero विधि: लागू करने के लिए आसान, विश्वसनीय, बहुत तेज़ है, लेकिन फ़ार्मुलों को निकालता है
  2. नई शीट विधि: कार्यान्वयन, विश्वसनीय, और लक्ष्य को पूरा करने में आसान है
  3. स्ट्रिंग विधि: कार्यान्वयन के लिए अधिक प्रयास, विश्वसनीय, लेकिन आवश्यकता को पूरा नहीं करता है
  4. ऐरे विधि: स्ट्रिंग्स के समान, लेकिन रीडम्स एक सरणी (संघ का तेज संस्करण)
  5. त्वरित और आसान: लागू करने के लिए आसान (कम, विश्वसनीय और सुरुचिपूर्ण), लेकिन आवश्यकता को पूरा नहीं करता है
  6. रेंज यूनियन: 2 और 3 के समान कार्यान्वयन जटिलता, लेकिन बहुत धीमी गति से

मैंने असामान्य मूल्यों को शुरू करके परीक्षण डेटा को और अधिक यथार्थवादी बना दिया है:

  • रिक्त कक्ष, श्रेणियां, पंक्तियां, और कॉलम
  • विशेष वर्ण, जैसे = [`~! @ # $% ^ & * () _- + {} [] \ | |: '',। <> – ?, अलग और एकाधिक संयोजन
  • रिक्त स्थान, टैब, रिक्त फ़ार्मुलों, सीमा, फ़ॉन्ट और अन्य सेल फ़ॉर्मेटिंग
  • दशकों के साथ बड़ी और छोटी संख्या (= 12.9999999999999 + 0.00000000000000001)
  • हाइपरलिंक, सशर्त स्वरूपण नियम
  • डेटा श्रेणियों के अंदर और बाहर खाली स्वरूपण
  • जो कुछ भी डेटा के मुद्दों को हो सकता है

Solutions Collecting From Web of "एक्सेल वीबीए प्रदर्शन – 1 मिलियन पंक्तियाँ – 1 मिनट से कम में मूल्य युक्त पंक्तियों को हटाएं"

मैं एक संदर्भ के रूप में पहला जवाब प्रदान कर रहा हूं

दूसरों को यह उपयोगी हो सकता है, अगर कोई अन्य विकल्प उपलब्ध नहीं हैं

  • परिणाम प्राप्त करने का सबसे तेज़ तरीका हटाना ऑपरेशन का उपयोग नहीं करना है
  • 1 मिलियन रिकॉर्डों में से यह 33 सेकंड के औसत में 100,000 पंक्तियों को निकालता है

 Sub DeleteRowsWithValuesNewSheet() '100K records 10K to delete 'Test 1: 2.40234375 sec 'Test 2: 2.41796875 sec 'Test 3: 2.40234375 sec '1M records 100K to delete 'Test 1: 32.9140625 sec 'Test 2: 33.1484375 sec 'Test 3: 32.90625 sec Dim oldWs As Worksheet, newWs As Worksheet, rowHeights() As Long Dim wsName As String, t As Double, oldUsedRng As Range FastWB True: t = Timer Set oldWs = Worksheets(1) wsName = oldWs.Name Set oldUsedRng = oldWs.Range("A1", GetMaxCell(oldWs.UsedRange)) If oldUsedRng.Rows.Count > 1 Then 'If sheet is not empty Set newWs = Sheets.Add(After:=oldWs) 'Add new sheet With oldUsedRng .AutoFilter Field:=1, Criteria1:="<>Test String" .Copy 'Copy visible data End With With newWs.Cells .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteAll 'Paste data on new sheet .Cells(1, 1).Select 'Deselect paste area .Cells(1, 1).Copy 'Clear Clipboard End With oldWs.Delete 'Delete old sheet newWs.Name = wsName End If FastWB False: InputBox "Duration: ", "Duration", Timer - t End Sub 

उच्च स्तर पर:

  • यह एक नया वर्कशीट बनाता है, और प्रारंभिक शीट के लिए एक संदर्भ रखता है
  • खोजा गया पाठ पर .AutoFilter Field:=1, Criteria1:="<>Test String" कॉलम 1: .AutoFilter Field:=1, Criteria1:="<>Test String"
  • प्रारंभिक शीट से सभी (दृश्यमान) डेटा की प्रतियां
  • नई शीट में कॉलम चौड़ाई, प्रारूप और डेटा चिपकाता है
  • प्रारंभिक पत्र हटाता है
  • पुराने शीट नाम पर नई शीट का नाम बदलता है

यह प्रश्न में पोस्ट किए गए एक ही सहायक कार्यों का उपयोग करता है

अवधि का 99% ऑटोफिल्टर द्वारा उपयोग किया जाता है

कुछ ऐसी सीमाएं हैं जो मैं अभी तक पाया, पहले को संबोधित किया जा सकता है:

  1. यदि प्रारंभिक शीट पर कोई छिपी हुई पंक्तियाँ हैं, तो उन्हें यह दिखता है

    • उन्हें छिपाने के लिए एक अलग फ़ंक्शन की आवश्यकता है
    • कार्यान्वयन के आधार पर, यह अवधि काफी महत्वपूर्ण हो सकती है
  2. संबंधित VBA:

    • यह शीट का कोड नाम बदलता है; अन्य वीबीए को शीट 1 का जिक्र किया जाएगा (यदि कोई है)
    • यह आरंभिक शीट (यदि कोई हो) से जुड़े सभी VBA कोड को हटा देता है

इस तरह बड़ी फ़ाइलों का उपयोग करने के बारे में कुछ नोट्स:

  • बाइनरी प्रारूप (.xlsb) फ़ाइल आकार नाटकीय रूप से कम करता है (137 एमबी से 43 एमबी तक)
  • अप्रबंधित सशर्त स्वरूपण नियम घातीय प्रदर्शन समस्याओं का कारण हो सकते हैं

    • टिप्पणियों और डेटा सत्यापन के लिए एक ही है
  • नेटवर्क से फ़ाइल या डेटा पढ़ना एक स्थानीय फ़ाइल के साथ काम करने से बहुत धीमी है

यदि सशर्त डेटा में सूत्र नहीं होते हैं या यदि परिदृश्य (या चाहते हैं) सशर्त पंक्ति हटाए जाने के दौरान सूत्रों को कठिन मानों में परिवर्तित करने के लिए गति में महत्वपूर्ण लाभ प्राप्त किया जा सकता है।

चेतावनी के रूप में उपरोक्त के साथ, मेरा समाधान श्रेणी ऑब्जेक्ट के उन्नतफ़िल्टर का उपयोग करता है। इसके बारे में दो बार के रूप में तेजी से DeleteRowsWithValuesNewSheet () है।

 Public Sub ExcelHero() Dim t#, crit As Range, data As Range, ws As Worksheet Dim r&, fc As Range, lc As Range, fr1 As Range, fr2 As Range FastWB True t = Timer Set fc = ActiveSheet.UsedRange.Item(1) Set lc = GetMaxCell Set data = ActiveSheet.Range(fc, lc) Set ws = Sheets.Add With data Set fr1 = data.Worksheet.Range(fc, fc.Offset(, lc.Column)) Set fr2 = ws.Range(ws.Cells(fc.Row, fc.Column), ws.Cells(fc.Row, lc.Column)) With fr2 fr1.Copy .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAll .Item(1).Select End With Set crit = .Resize(2, 1).Offset(, lc.Column + 1) crit = [{"Column 1";"<>Test String"}] .AdvancedFilter xlFilterCopy, crit, fr2 .Worksheet.Delete End With FastWB False r = ws.UsedRange.Rows.Count Debug.Print "Rows: " & r & ", Duration: " & Timer - t & " seconds" End Sub 

मेरी बुजुर्ग डेल इंस्पेरॉन 1564 (7 विन ऑफिस 2007) पर यह:

 Sub QuickAndEasy() Dim rng As Range Set rng = Range("AA2:AA1000001") Range("AB1") = Now Application.ScreenUpdating = False With rng .Formula = "=If(A2=""Test String"",0/0,A2)" .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete .Clear End With Application.ScreenUpdating = True Range("AC1") = Now End Sub 

चलाने के बारे में 10 सेकंड ले लिया मैं मान रहा हूं कि स्तंभ एए उपलब्ध है।

संपादित करें # 1:

कृपया ध्यान दें कि यह कोड मैनुअल के लिए गणना सेट नहीं करता है। "सहायक" कॉलम की गणना करने के लिए अनुमति देने के बाद यदि गणना मोड मैन्युअल पर सेट होता है तो प्रदर्शन में सुधार होगा।

मुझे पता है कि मैं अपने जवाब के साथ अविश्वसनीय रूप से देर कर रहा हूं, हालांकि भविष्य के आगंतुक इसे बहुत उपयोगी पा सकते हैं।

कृपया ध्यान दें: मेरे दृष्टिकोण को मूल क्रम में समाप्त करने के लिए पंक्तियों के लिए एक सूचकांक स्तंभ की आवश्यकता होती है, हालांकि यदि आप किसी अन्य क्रम में होने वाली पंक्तियों को ध्यान नहीं देते हैं तो एक सूचकांक स्तंभ की आवश्यकता नहीं है और कोड की अतिरिक्त पंक्ति को हटाया जा सकता है ।

मेरा दृष्टिकोण: मेरा दृष्टिकोण केवल चयनित श्रेणी (स्तंभ) में सभी पंक्तियों का चयन करना था, उन्हें रेंज का उपयोग करके आरोही क्रम में सॉर्ट करना था और फिर चयनित श्रेणी (स्तंभ) के भीतर "Test String" का पहला और अंतिम सूचकांक इकट्ठा करना था। मैं तब पहले और अंतिम सूचकांक से एक श्रेणी बनाऊं और रेंज का उपयोग करें। Range.EntrieRow.Delete पंक्तियों को हटाने के लिए हटाएं, जिसमें "Test String" शामिल हैं

पेशेवरों:
– यह तेज तेज़ी से है
– यह स्वरूपण, सूत्र, चार्ट, चित्र या किसी भी तरह की विधि को हटा नहीं करता है, जो एक नई शीट की नकल करता है।

विपक्ष:
– लागू करने के लिए कोड का एक सभ्य आकार, हालांकि यह सभी सीधे आगे है।

टेस्ट रेंज जनरेशन उप:

 Sub DevelopTest() Dim index As Long FastWB True ActiveSheet.UsedRange.Clear For index = 1 To 1000000 '1 million test ActiveSheet.Cells(index, 1).Value = index If (index Mod 10) = 0 Then ActiveSheet.Cells(index, 2).Value = "Test String" Else ActiveSheet.Cells(index, 2).Value = "Blah Blah Blah" End If Next index Application.StatusBar = "" FastWB False End Sub 

फ़िल्टर करें और पंक्तियाँ हटाएं उप:

 Sub DeleteRowFast() Dim curWorksheet As Worksheet 'Current worksheet vairable Dim rangeSelection As Range 'Selected range Dim startBadVals As Long 'Start of the unwanted values Dim endBadVals As Long 'End of the unwanted values Dim strtTime As Double 'Timer variable Dim lastRow As Long 'Last Row variable Dim lastColumn As Long 'Last column variable Dim indexCell As Range 'Index range start Dim sortRange As Range 'The range which the sort is applied to Dim currRow As Range 'Current Row index for the for loop Dim cell As Range 'Current cell for use in the for loop On Error GoTo Err Set rangeSelection = Application.InputBox("Select the (N=) range to be checked", "Get Range", Type:=8) 'Get the desired range from the user Err.Clear M1 = MsgBox("This is recommended for large files (50,000 or more entries)", vbYesNo, "Enable Fast Workbook?") 'Prompt the user with an option to enable Fast Workbook, roughly 150% performace gains... Recommended for incredibly large files Select Case M1 Case vbYes FastWB True 'Enable fast workbook Case vbNo FastWB False 'Disable fast workbook End Select strtTime = Timer 'Begin the timer Set curWorksheet = ActiveSheet lastRow = CLng(rangeSelection.SpecialCells(xlCellTypeLastCell).Row) lastColumn = curWorksheet.Cells(1, 16384).End(xlToLeft).Column Set indexCell = curWorksheet.Cells(1, 1) On Error Resume Next If rangeSelection.Rows.Count > 1 Then 'Check if there is anything to do lastVisRow = rangeSelection.Rows.Count Set sortRange = curWorksheet.Range(indexCell, curWorksheet.Cells(curWorksheet.Rows(lastRow).Row, 16384).End(xlToLeft)) 'Set the sort range sortRange.Sort Key1:=rangeSelection.Cells(1, 1), Order1:=xlAscending, Header:=xlNo 'Sort by values, lowest to highest startBadVals = rangeSelection.Find(What:="Test String", LookAt:=xlWhole, MatchCase:=False).Row endBadVals = rangeSelection.Find(What:="Test String", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row curWorksheet.Range(curWorksheet.Rows(startBadVals), curWorksheet.Rows(endBadVals)).EntireRow.Delete 'Delete uneeded rows, deleteing in continuous range blocks is quick than seperated or individual deletions. sortRange.Sort Key1:=indexCell, Order1:=xlAscending, Header:=xlNo 'Sort by index instead of values, lowest to highest End If Application.StatusBar = "" 'Reset the status bar FastWB False 'Disable fast workbook MsgBox CStr(Round(Timer - strtTime, 2)) & "s" 'Display duration of task Err: Exit Sub End Sub 

इस कोड में FastWB , FastWS और EnableWS द्वारा EnableWS

100K प्रविष्टियों में समय (10k को हटाया जाना है, फास्टब्लूबी ट्रू):
1. 0.2 सेकंड
2. 0.2 सेकंड
3. 0.21 सेकंड
औसत। 0.2 सेकेंड

टाइम्स पर 1 मिलियन प्रविष्टियां (100 किमी को हटाया जा सकता है, फास्टब्लूबी ट्रू):
1. 2.3 सेकंड
2. 2.32 सेकंड
3. 2.3 सेकंड
औसत। 2.31 सेकंड

चल रहा है: विंडोज 10, आईएमएसी आई 3 11,2 (2010 से)

संपादित करें
यह कोड मूल रूप से एक संख्यात्मक सीमा के बाहर अंकीय मूल्यों को फ़िल्टर करने के उद्देश्य से तैयार किया गया था और "Test String" को फ़िल्टर करने के लिए अनुकूलित किया गया है, इसलिए कुछ कोड बेमानी हो सकता है

उपयोग की गई रेंज और पंक्ति गणना की गणना में आपके एरे का उपयोग प्रदर्शन को प्रभावित कर सकता है। यहां एक और दृष्टिकोण है जो परीक्षण में डेटा के 1 एम + पंक्तियों में 25-30 सेकंड के बीच कुशल साबित होता है। यह फिल्टर का उपयोग नहीं करता है, इसलिए छिपाए हुए भी पंक्तियों को हटा देगा। पूरी पंक्ति हटाने से अन्य शेष पंक्तियों के स्वरूपण या स्तंभ चौड़ाई प्रभावित नहीं होंगे।

  1. सबसे पहले, जांचें कि क्या ActiveSheet में "टेस्ट स्ट्रिंग" है चूंकि आप कॉलम 1 में केवल दिलचस्पी रखते हैं I

     TCount = Application.WorksheetFunction.CountIf(sht.Columns(1), "Test String") If TCount > 0 Then 
  2. अपने GetMaxCell () फ़ंक्शन का उपयोग करने के बजाय मैं केवल Cells.SpecialCells(xlCellTypeLastCell).Row प्रयोग किया। Cells.SpecialCells(xlCellTypeLastCell).Row । अंतिम पंक्ति प्राप्त करने के लिए पंक्ति:

     EndRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row 
  3. फिर डेटा की पंक्तियों के माध्यम से पाश करें:

     While r <= EndRow 
  4. जांचने के लिए कि कॉलम 1 में सेल "टेस्ट स्ट्रिंग" के बराबर है:

     If sht.Cells(r, 1).Text) = "Test String" Then 
  5. पंक्ति हटाने के लिए:

     Rows(r).Delete Shift:=xlUp 

नीचे सभी को एक साथ पूरे कोड डालना मैंने ActiveSheet को एक चर शाफ्ट में सेट किया है और दक्षता में सुधार करने के लिए स्क्रीन अपडेटिंग को चालू कर दिया है। चूंकि यह बहुत सारे डेटा है, इसलिए मैं अंत में वेरिएबल को साफ करने के लिए सुनिश्चित करता हूं।

 Sub RowDeleter() Dim sht As Worksheet Dim r As Long Dim EndRow As Long Dim TCount As Long Dim s As Date Dim e As Date Application.ScreenUpdating = True r = 2 'Initialise row number s = Now 'Start Time Set sht = ActiveSheet EndRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row 'Check if "Test String" is found in Column 1 TCount = Application.WorksheetFunction.CountIf(sht.Columns(1), "Test String") If TCount > 0 Then 'loop through to the End row While r <= EndRow If InStr(sht.Cells(r, 1).Text, "Test String") > 0 Then sht.Rows(r).Delete Shift:=xlUp r = r - 1 End If r = r + 1 Wend End If e = Now 'End Time D = (Hour(e) * 360 + Minute(e) * 60 + Second(e)) - (Hour(s) * 360 + Minute(s) * 60 + Second(s)) Application.ScreenUpdating = True DurationTime = TimeSerial(0, 0, D) MsgBox Format(DurationTime, "hh:mm:ss") End Sub