मेरे पास अलग-अलग पत्रक हैं जिन्हें कहा जाता है:

"शैम्पेन"
"पानी"
"चोकोस्ट्रॉब"
"कांस्य"
"सिल्वर"
"गोल्ड"
"प्लैटिनम"
"प्लस"
"दूत"

मेरे पास यह कोड है:

Sheets("water").Select
Dim rng As Range, cell_search As Range, del As Range
Set rng = Intersect(Range("A2:A4200"), ActiveSheet.UsedRange)
For Each cell_search In rng
    If (cell_search.Value) = "Delete" Then
        If del Is Nothing Then
            Set del = cell_search
        Else: Set del = Union(del, cell_search)
    End If
End If
Next cell_search
On Error Resume Next
del.EntireRow.Delete

लेकिन यह केवल "पानी" शीट में पंक्ति को हटा देता है, मैं चाहता हूं कि यह सभी शीट्स में प्रभावी हो।

1
JohanEs 6 मार्च 2017, 03:34

2 जवाब

सबसे बढ़िया उत्तर

आप एक मैक्रो बना सकते हैं जो आपकी कार्यपुस्तिका में प्रत्येक कार्यपत्रक के माध्यम से चलता है:

Sub AllWorkbooks()
Dim WS As Worksheet

For Each WS In ActiveWorkbook.Worksheets
    For x = 4200 To 2 Step -1
        If WS.Cells(x, 1).Value = "Delete" Then
            WS.Rows(x).EntireRow.Delete
        End If
    Next x
Next WS

End Sub
2
VBA Pete 7 मार्च 2017, 02:25

Autofilter() चीजों को गति देगा

आप एक उप द्वारा शुरू कर सकते हैं जो एक पारित worksheet ऑब्जेक्ट को "हैंडल" करता है:

Sub DeleteRowsWithKeyword(sht As Worksheet, keyWord As String)
    With sht '<--| reference passed sht
        With .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column A range form row 1 (header) down to its last not empty row
            .AutoFilter Field:=1, Criteria1:=keyWord '<--| filter cells with passed 'keyWord'
            If Application.WorksheetFunction.Subtotal(103, .cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete  '<--| if any filtered cells other than header then delete their entore row
        End With
        .AutoFilterMode = False
    End With
End Sub

और फिर आप अपना "मुख्य" उप शोषण कर सकते हैं

  • सभी कार्यपत्रकों के माध्यम से लूप

    Sub Main()
        Dim sht As Worksheet
    
        For Each sht In Worksheets
            DeleteRowsWithKeyword sht, "Delete"
        Next
    End Sub
    
  • दिए गए नामों के साथ सभी शीटों के माध्यम से लूप करें:

    Sub Main()
        Dim sheetNames As Variant, shtName As Variant
    
        sheetNames = Array("Champagne", "Water", "ChocoStrawb", "Bronze", "Silver", "Gold", "Platinum", "PlPlus", "Ambassador") '<--| list all your relevant sheet names here
        For Each shtName In sheetNames
            DeleteRowsWithKeyword Sheets(shtName), "Delete"
        Next
    End Sub
    
0
user3598756 6 मार्च 2017, 10:42