Supportnet / Forum / Tabellenkalkulation
Zeile mit einem bestimmten Wert in Spalte B via Makro löschen
Frage
Hallo,
eine Tabelle mit sehr vielen Datensätzen die ich nach bestimmten Kriterien filtere. Nun sollen alle Datensätze mit dem Wert y in Spalte B automatisch (Makro) gelöscht werden. Wer kann mir dazu helfen?
Antwort 1 von fürLau
Hallo
Das könnte so gehen:
Gruß
Das könnte so gehen:
Option Explicit
Private Sub CommandButton1_Click()
Dim i&, y&
y = InputBox("Welcher Wert soll gelöscht werden ?")
For i = 2 To Range("B65535").End(xlUp).Row
If Cells(i, 2).Value = y Then
ActiveSheet.Rows(i).Delete Shift:=xlShiftUp
End If
Next
End Sub
Gruß
Antwort 2 von nighty
hi all
noch eine variante
gruss nighty
@fürLau
vielleicht interrassant :))
hier kommt die find function zum einsatz die bei fund ihre position an die for next schleife als neuen startwert fuer die naechste suche beim naechsten durchlauf uebergibt
Sub such()
Dim suche1 As Range
Dim zaehler1 As Long
Dim DeinSuchwert As Variant
DeinSuchwert = "y"
Application.ScreenUpdating = False
For zaehler1 = 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
zeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Rem die var DeinSuchwert ist der suchbegriff,zur zeit noch als variant oben angegeben
Set suche1 = Sheets(1).Range("B" & zaehler1 & ":B" & zeile).Find(DeinSuchwert, LookIn:=xlValues)
If Not suche1 Is Nothing Then
zaehler1 = suche1.Row - 2
If zaehler1 < 1 Then zaehler1 = 1
Sheets(1).Range(suche1.Row & ":" & suche1.Row).Delete Shift:=xlUp
Else
Exit For
End If
Next zaehler1
Application.ScreenUpdating = True
End Sub
noch eine variante
gruss nighty
@fürLau
vielleicht interrassant :))
hier kommt die find function zum einsatz die bei fund ihre position an die for next schleife als neuen startwert fuer die naechste suche beim naechsten durchlauf uebergibt
Sub such()
Dim suche1 As Range
Dim zaehler1 As Long
Dim DeinSuchwert As Variant
DeinSuchwert = "y"
Application.ScreenUpdating = False
For zaehler1 = 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
zeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Rem die var DeinSuchwert ist der suchbegriff,zur zeit noch als variant oben angegeben
Set suche1 = Sheets(1).Range("B" & zaehler1 & ":B" & zeile).Find(DeinSuchwert, LookIn:=xlValues)
If Not suche1 Is Nothing Then
zaehler1 = suche1.Row - 2
If zaehler1 < 1 Then zaehler1 = 1
Sheets(1).Range(suche1.Row & ":" & suche1.Row).Delete Shift:=xlUp
Else
Exit For
End If
Next zaehler1
Application.ScreenUpdating = True
End Sub
Antwort 3 von nighty
hi all :))
hier noch eine do loop variante :)))
gruss nighty
Option Explicit
Sub such()
Dim suche As Range
Dim zeilen As Long
Dim zaehler As Long
Dim DeinWert As Variant
zeilen = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Do While zaehler < zeilen
zaehler = zaehler + 1
Set suche = Sheets(1).Range("B" & zaehler & ":B" & zeilen).Find(DeinWert, LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(1).Range(suche.Row & ":" & suche.Row).Delete Shift:=xlUp
zeilen = zeilen - 1
End If
Loop
End Sub
hier noch eine do loop variante :)))
gruss nighty
Option Explicit
Sub such()
Dim suche As Range
Dim zeilen As Long
Dim zaehler As Long
Dim DeinWert As Variant
zeilen = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Do While zaehler < zeilen
zaehler = zaehler + 1
Set suche = Sheets(1).Range("B" & zaehler & ":B" & zeilen).Find(DeinWert, LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(1).Range(suche.Row & ":" & suche.Row).Delete Shift:=xlUp
zeilen = zeilen - 1
End If
Loop
End Sub
Antwort 4 von Pille0815
Vielen Dank!
Die Variante aus Antwort 2 funktioniert.
Hab noch eine Frage dazu. Wird jede Zelle durchfahren oder nur die Zellen in der Spalte B?
Hab nämlich ca. 40000 Datensätze und bei 10000 Datensätzen dauert es 3,5 min bis das Makro fertig ist.
Gruß
Die Variante aus Antwort 2 funktioniert.
Hab noch eine Frage dazu. Wird jede Zelle durchfahren oder nur die Zellen in der Spalte B?
Hab nämlich ca. 40000 Datensätze und bei 10000 Datensätzen dauert es 3,5 min bis das Makro fertig ist.
Gruß
Antwort 5 von nighty
hi pille :)
als schleifenkonstuct ist es schon das optimum,da der jeweilige startwert die position der letzten gefundenen suche wird.
es besteht noch die möglichkeit die spalte b variablen zu uebergeben die beim oeffnen der datei uebergeben
werden und somit natuerlich auch um etliches schneller sein duerfte
ich probier mich mal die tage
gruss nighty
als schleifenkonstuct ist es schon das optimum,da der jeweilige startwert die position der letzten gefundenen suche wird.
es besteht noch die möglichkeit die spalte b variablen zu uebergeben die beim oeffnen der datei uebergeben
werden und somit natuerlich auch um etliches schneller sein duerfte
ich probier mich mal die tage
gruss nighty
Antwort 6 von nighty
hi pille :)
hier noch eine variante, idee von schnallgonz :))
vielleicht schon ausreichend ?
gruss nighty
Sub Loeschen()
Application.ScreenUpdating = False
Sheets(1).Range("B1:B" & Sheets(1).Range("B65536").End(xlUp).Row).AutoFilter field:=1, Criteria1:="x", VisibleDropDown:=False
Sheets(1).Range("2:" & Sheets(1).Range("B65536").End(xlUp).Row).Delete Shift:=xlUp
Sheets(1).Cells(1, 2).AutoFilter field:=1
Application.ScreenUpdating = True
End Sub
hier noch eine variante, idee von schnallgonz :))
vielleicht schon ausreichend ?
gruss nighty
Sub Loeschen()
Application.ScreenUpdating = False
Sheets(1).Range("B1:B" & Sheets(1).Range("B65536").End(xlUp).Row).AutoFilter field:=1, Criteria1:="x", VisibleDropDown:=False
Sheets(1).Range("2:" & Sheets(1).Range("B65536").End(xlUp).Row).Delete Shift:=xlUp
Sheets(1).Cells(1, 2).AutoFilter field:=1
Application.ScreenUpdating = True
End Sub