एक्सेल में सभी शीट में स्वचालित रूप से "डिलीट" वाली सभी पंक्तियों को कैसे हटाएं?

Question

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

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

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

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

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

vba excel

1

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

Answer 1

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

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

Answer 2

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

एक्सेल में सभी शीट में स्वचालित रूप से "डिलीट" वाली सभी पंक्तियों को कैसे हटाएं?

2 जवाब

संबंधित सवाल

नए सवाल

vba