Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Zeilen löschen nach Multiselektion
zurück: Zeile einfügen, wenn Inhalt nicht Null weiter: Zwei Spalten von Sotierub Bereich ausschliessen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
cschaden
Excel-Kenner, VBA-lernwillig


Verfasst am:
17. Jun 2011, 17:17
Rufname:
Wohnort: Budenheim

Zeilen löschen nach Multiselektion - Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hallo zusammen,

aus allen Blättern einer Datei sollen Zeilen aufgrund von Kriterien gelöscht werden.
Bislang hatte ich einen Suchstring (searchNo), der in eine Userform eingegeben wird. Alle Zeilen, die diesen Wert in der ersten Spalte beinhalten, werden über folgenden Code gelöscht.

Code:
wsNumber = ThisWorkbook.Worksheets.Count
        For j = 2 To wsNumber
            With ThisWorkbook.Worksheets(j)
                .Select
                        For Each cell In Intersect(ActiveSheet.UsedRange, Columns(1))
                            If cell.Row > 1 Then
                                Select Case Cells(cell.Row, 1).Value
                                    Case searchNo
                                    Case Else
                                        If rng Is Nothing Then
                                            Set rng = cell.EntireRow
                                            Else
                                            Set rng = Union(rng, cell.EntireRow)
                                        End If
                                End Select
                            End If
                        Next
                            If Not rng Is Nothing Then
                                rng.Delete
                            End If
            End With
            Set rng = Nothing
        Next j


Nun möchte ich den Code so ändern, dass in einer Listbox eine Multiselektion von Werten vorgenommen wird (bis dahin habe ich es) und in allen Blättern die Zeilen gelöscht werden, deren Wert aus der ersten Spalte keinem der selektierten Werte entspricht.

Ich stelle mir folgendes vor, bekomme es aber nicht hin:
1. Übergabe der Multiselektion an ein Array
2. Abgleich der Array-Inhalte mit den Werten in den ersten Spalten
3. Löschen der Zeilen, deren Wert aus der ersten Spalte nicht dem Sucharray entspricht


Eine (unschöne und sicher wesentlich langsamere) Alternative, wäre:
a) Selektierte Werte zeilenweise in ein Tabellenblatt schreiben
b) Filtern über Spezialfilter unter vorhandene Zeilen
c) Löschen der Ursprungsdaten


Hier scheitere ich leider an a). Sad

Ich bin dankbar für jede Hilfe!
Viele Grüße
Christian


P.S.: Der Code müsste auch unter 2003 funktionieren.

_________________
- Office XP und 2003 -
Gast



Verfasst am:
18. Jun 2011, 16:09
Rufname:


AW: Zeilen löschen nach Multiselektion - AW: Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hi,

lies deine Spalte A in ein Array und lass es gegen ein zweites Array mit deinen Suchbegriffen laufen. Damit kannst du die Zeilennummern der nicht gewünschten Zeilen ermittel, die du dann anschließend von unten beginnend nach oben löschst.

Code:
Sub löschen()

Dim ar1 As Variant
Dim ar2() As Variant
Dim i As Long, j As Long, z As Long
Dim strZeile As String
Dim loesch As Variant
Dim wks As Worksheet

' Aus Listbox die selektierten Werte in Array ar2 übernehmen
z = 0
For i = LBound(ActiveSheet.ListBox1.List) To UBound(ActiveSheet.ListBox1.List)
  If ActiveSheet.ListBox1.Selected(i) = True Then
    ReDim Preserve ar2(z)
    ar2(z) = ActiveSheet.ListBox1.List(i)
    z = z + 1
  End If
Next i

' jedes Tabellenblatt bearbeiten

For Each wks In ThisWorkbook.Worksheets

'Spalte A in Array ar1 übernehmen
ar1 = wks.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

'ar1 und ar2 gegeneinander prüfen , bei übereinstimmung Zeilennummer festhalten
    For i = LBound(ar1, 1) To UBound(ar1, 1)
        For j = LBound(ar2) To UBound(ar2)
            If ar1(i, 1) <> ar2(j) Then strZeile = strZeile & i & ","
        Next j
    Next i
   
    'Zeilennummern bearbeiten
    strZeile = Left(strZeile, Len(strZeile) - 1)
    loesch = Split(strZeile, ",")
   
    'Zeilen löschen
    For i = UBound(loesch) To LBound(loesch) Step -1
        Rows(loesch(i)).EntireRow.Delete
    Next

Next
End Sub


Probiere mal aus
Du musst noch Anpassungen vornehmen für den Ort deiner Listbox und ggfs für die Auswahl der Tabellenblätter

Grüßli
Gast



Verfasst am:
18. Jun 2011, 16:26
Rufname:

AW: Zeilen löschen nach Multiselektion - AW: Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hi,

halt noch mal an,

hatte zum Schluß bemerkt, dass du das mit den Übereinstimmungen umgekehrt gemeint hattest und habe einfach so aus meinem if Ar1 = ar2 ein if ar1 <> ar2 gemacht.
Das war mist, denn das löscht alles.

Kleinen Moment

Grüßli
Gast



Verfasst am:
18. Jun 2011, 17:34
Rufname:

AW: Zeilen löschen nach Multiselektion - AW: Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hi,

nun aber

Code:
Sub löschen()

Dim ar1 As Variant
Dim ar2() As Variant
Dim i As Long, j As Long, z As Long
Dim strZeile As String
Dim loesch As Variant
Dim wks As Worksheet
Dim Zeile As Boolean
' Aus Listbox die selektierten Werte in Array ar2 übernehmen
z = 0
For i = LBound(Sheets("Tabelle1").ListBox1.List) To UBound(ActiveSheet.ListBox1.List)
  If ActiveSheet.ListBox1.Selected(i) = True Then
    ReDim Preserve ar2(z)
    ar2(z) = ActiveSheet.ListBox1.List(i)
    z = z + 1
  End If
Next i

' jedes Tabellenblatt bearbeiten

For Each wks In ThisWorkbook.Worksheets
wks.Activate
'Spalte A in Array ar1 übernehmen
ar1 = wks.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

'ar1 und ar2 gegeneinander prüfen , bei übereinstimmung Zeilennummer festhalten
    For i = LBound(ar1, 1) To UBound(ar1, 1)
        For j = LBound(ar2) To UBound(ar2)
            If ar1(i, 1) = ar2(j) Then strZeile = strZeile & i & ","
        Next j
    Next i
   
    'Zeilennummern bearbeiten
    strZeile = Left(strZeile, Len(strZeile) - 1)
    loesch = Split(strZeile, ",")
   
    'Zeilen löschen
   
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    Zeile = False
        For j = UBound(loesch) To LBound(loesch) Step -1
            If CLng(loesch(j)) = i Then Zeile = True
        Next
    If Zeile = False Then wks.Rows(i).Delete
    Next

Next
End Sub


Grüßli
Gast



Verfasst am:
18. Jun 2011, 20:17
Rufname:

AW: Zeilen löschen nach Multiselektion - AW: Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hallo Gast!

Vielen, vielen Dank!! Very Happy
Nach Anpassungen an meine Situation funktioniert der Code einwandfrei.

Eine Ergänzung musste ich noch vornehmen:
Der String strZeile muss nach dem Löschen (nach Aktivieren des nächsten Sheets) geleert werden.

Wochenende gerettet Smile

Wünsche einen schönen Abend und einen schönen Sonntag!

Viele Grüße
Christian
cschaden
Excel-Kenner, VBA-lernwillig


Verfasst am:
18. Jun 2011, 20:21
Rufname:
Wohnort: Budenheim


AW: Zeilen löschen nach Multiselektion - AW: Zeilen löschen nach Multiselektion

Nach oben
       Version: Office 2007

Hoppla, war nicht eingeloggt...

Dankeschöööön!

_________________
- Office XP und 2003 -
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Zeilen zusammenfügen 8 nasi 1050 14. Jul 2005, 15:26
tom_r Zeilen zusammenfügen
Keine neuen Beiträge Excel Formeln: Excel Verknüpfungen löschen 9 Acidcool73 15705 15. Jun 2005, 16:03
Gast Excel Verknüpfungen löschen
Keine neuen Beiträge Excel Formeln: Farbige Zeilen bei verschiedenen Kriterien 10 Nixweis 1254 09. Jun 2005, 13:59
Nixweiß Farbige Zeilen bei verschiedenen Kriterien
Keine neuen Beiträge Excel Formeln: Leere Zeilen mit Formel ausblenden 4 austin1980 2980 21. Apr 2005, 20:33
Günni Leere Zeilen mit Formel ausblenden
Keine neuen Beiträge Excel Formeln: Leere Zeilen vom Kombinationsfeld löschen 5 sifak 1332 19. Apr 2005, 17:11
Hübi Leere Zeilen vom Kombinationsfeld löschen
Keine neuen Beiträge Excel Formeln: Löschen von "versteckten" Zeilen 1 Natalie 866 16. März 2005, 20:53
fl618 Löschen von "versteckten" Zeilen
Keine neuen Beiträge Excel Formeln: Zeilen per Formel ein- und ausblenden 2 Gotha 1548 30. Dez 2004, 10:28
Gotha Zeilen per Formel ein- und ausblenden
Keine neuen Beiträge Excel Formeln: Doppelte Einträge aus Excel Tabellen löschen 3 Richkid 2831 09. Dez 2004, 15:45
Reinhard Doppelte Einträge aus Excel Tabellen löschen
Keine neuen Beiträge Excel Formeln: Leerzeichen löschen klappt mit GLÄTTEN() nicht 10 waterboy 1366 26. Nov 2004, 23:31
Gast Leerzeichen löschen klappt mit GLÄTTEN() nicht
Keine neuen Beiträge Excel Formeln: Zeilen Minimum 2 -Christoph- 1736 22. Nov 2004, 13:01
-Christoph- Zeilen Minimum
Keine neuen Beiträge Excel Formeln: Daten in Zeilen in Spalten verschieben 2 Benja 1570 18. Okt 2004, 15:21
Benja Daten in Zeilen in Spalten verschieben
Keine neuen Beiträge Excel Formeln: Leerzeichen in Zelle löschen 3 pkegelking 1807 01. Okt 2004, 11:57
pkegelking Leerzeichen in Zelle löschen
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Web Editor Forum