Durch Komma getrennte Werte in Inputbox verarbeite

Hallo,
ich hoffe mir kann einer bei meinem Problem Helfen.
Ich habe ein Excel-Sheet mit ca. 50000 Zeilen und 9 Spalten.
In Spalte C steht jeweils eine Nummer welche eine bestimmte Gruppe definiert( 1 - 127).
Da einige Gruppen gelösacht werden sollen wollte ich mir ein Makro schreiben mit dem ich mittels Inputbox
abfrage welche Gruppen gelöscht werden sollen.
Das hab ich für jeweils eine einzelne Gruppen auch hinbekommen.
Nun muss ich aber mehr als 20 Gruppen löschen und wollte es gern so machen das ich die zu löschenden
Gruppen, durch Komma getrennt, in die Inputbox eingebe und das Makro diese dann in einem Rutsch löscht.
Ich hab schon mehrere Sachen probiert aber nix hat funktioniert - was bestimmt nicht an Excel liegt :-(
Mein letzter Versuch war dieser hier:


Sub GruppenDel()
Dim x As Long
Dim Gruppe as String
Application.ScreenUpdating = False
Gruppe = InputBox("Zu löschende Gruppen durch ',' getrennt angeben.")
Sheets(1).Activate
Zeilen = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row  'letzte Zeile ermitteln
For x = Zeilen To 2 Step -1
Select Case Range("C" & x).Value
Case Gruppe
Rows(x).Delete Shift:=xlUp
End Select
Next x
Application.ScreenUpdating = True
End Sub

Dies ist glaube ich aber nicht der richtige Weg. Da hierbei ja nicht drauf geachtet wird ob nach dem Komma nun ein Leerzeichen kommt oder nicht. Ich könnt aber auch ohne diese Überprüfung leben und muss es mir nur merken.
Danke schonmal an der Stelle.
Gruss
Patrick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub GruppenDel() Dim x As Long Dim Gruppe as String Application.ScreenUpdating = False Gruppe = InputBox("Zu löschende Gruppen durch ',' getrennt angeben.") Gruppe = "," & Gruppe & "," Gruppe = Replace(Gruppe, " ", "") 'Leerzeichen entfernen Sheets(1).Activate Zeilen = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'letzte Zeile ermitteln For x = Zeilen To 2 Step -1 if instr(Gruppe, "," & Cells(x,3) & ",") > 0 then Rows(x).Delete Shift:=xlup Next x Application.ScreenUpdating = True End Sub

Hallo Patrick,

' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub GruppenDel()
  Dim lngRow As Long, lngLast As Long, lngIndex As Long
  Dim Gruppe As String, varNum As Variant, rng As Range
  Application.ScreenUpdating = False

  Gruppe = InputBox("Zu löschende Gruppen durch ',' getrennt angeben.")
  If Gruppe = "" Then Exit Sub
  varNum = Split(Gruppe, ",")

  With Sheets(1)
    lngLast = .UsedRange.SpecialCells(xlCellTypeLastCell).Row 'letzte Zeile ermitteln

    For lngRow = 2 To lngLast
      For lngIndex = 0 To UBound(varNum)
        If .Cells(lngRow, 3).Value = varNum(lngIndex) Then
          If rng Is Nothing Then
            Set rng = .Rows(lngRow)
          Else
            Set rng = Union(rng, .Rows(lngRow))
          End If
        End If
      Next
    Next

  End With

  If Not rng Is Nothing Then rng.Delete

  Application.ScreenUpdating = True

End Sub

Gruß Sepp

Sub Test() Dim strString As String Dim Bereich As Range, SortBereich As Range Dim LCol As Long Dim iCalc As Integer With Application iCalc = .Calculation .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual 'Bereich anpassen, hier Spalte 1 ab A2 (ohne Überschrift) Set Bereich = Range("A2", Cells(Rows.Count, 1).End(xlUp)) 'Inputbox Daten mit Komma getrennt eingeben ohne Leerzeichen dazwischen 'Beispiel Hans,Mayer,Fritz strString = InputBox("Zu löschende Gruppen durch ',' getrennt angeben.") If Right$(strString, 1) <> "," Then strString = strString & "," LCol = Bereich.Column Set Bereich = Bereich.Offset(0, Columns.Count - LCol) Set SortBereich = Bereich.Offset(0, -1) SortBereich.FormulaR1C1 = "=ROW()" Bereich.FormulaR1C1 = "=IF(ISERROR(FIND(RC" & LCol & "&"","",""" & strString & """)),"""",0)" If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then Range("A2", Cells(Rows.Count, Columns.Count)).Sort Bereich(1, 1), xlAscending, , , , , , xlNo Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete Range("A2", Cells(Rows.Count, Columns.Count)).Sort SortBereich(1, 1), xlAscending, , , , , , xlNo End If Columns(Columns.Count).Delete Columns(Columns.Count - 1).Delete .Calculation = iCalc .ScreenUpdating = True .EnableEvents = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Durch Komma getrennte Werte in Inputbox verarbeite

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Durch Komma getrennte Werte in Inputbox verarbeite

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread