Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1376to1380
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hallo Erich G.; erweiterte Prüfung

Hallo Erich G.; erweiterte Prüfung
13.08.2014 17:54:48
Lammi
Hallo zusammen,
vielen Dank Erich g. und Daniel.
..nach einigen Test habe ich festellen müssen, dass ich noch eine Erweiterung des Makros benötige.
Sub SelektivLoeschen2()
Dim arLR, arLC, arQ, rr As Long, cc As Long, ii As Long, rngR As Range, rngC As Range
With Sheets("Daten_bereinigen")
arLR = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
arLC = .Cells(1, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row)
End With
With ActiveSheet                          ' Sheets("Daten")
arQ = .Cells(1, 1).CurrentRegion
For rr = 1 To UBound(arQ)
For cc = 1 To UBound(arQ, 2)
If IsArray(arLR) Then
For ii = 2 To UBound(arLR)
If Not IsEmpty(arLR(ii, 1)) Then
If arQ(rr, cc) = arLR(ii, 1) Then
If rngR Is Nothing Then
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
End If
End If
Next ii
End If
If IsArray(arLC) Then
For ii = 2 To UBound(arLC)
If Not IsEmpty(arLC(ii, 1)) Then
If arQ(rr, cc) = arLC(ii, 1) Then
If rngC Is Nothing Then
Set rngC = .Columns(cc)
Else
Set rngC = Union(rngC, .Columns(cc))
End If
End If
End If
Next ii
End If
Next cc
Next rr
End With
If Not rngR Is Nothing Then rngR.Delete
If Not rngC Is Nothing Then rngC.Delete
End Sub

Neu:
Nach der Abarbeitung des Makro's 1 soll eine weitere Prüfung duchgeführt werden.
Zeilenprüfung:
Es sollen alle Zeilen gelöscht werden die unvollständig sind.
Anzahl der gefüllten Kopfzeile (A1-...) ≠ Anzahl der Daten
Zeile 5 und Zeile 16 enhalten weniger gefüllte Zellen wie Zeile 1.
Diese sollen gelöscht werden.
Es werden alle Zeilen mit der nachfolgenden Bedingung verbleiben.
Anzahl der Kopfzeilen = Anzahl der gefüllten Datenzellen.
Die Beispieldatei habe ich angepasst.
https://www.herber.de/bbs/user/92081.xlsx
Gruß
Lammi

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
VBA - Zeilen selektiv löschen
13.08.2014 18:39:44
Erich
Hi Lammi,
wegen dieser Zusatzfrage hätte es wohl keines neuen Threads bedurft, die Frage hättest du auch gleich in
Daten_bereinigen von Lammi vom 10.08.2014 07:20:08
stellen können.
Hier der neue Code (unter "--- neu"):

Sub SelektivLoeschen3()
Dim arLR, arLC, arQ, rr As Long, cc As Long, ii As Long, rngR As Range, rngC As Range
With Sheets("Daten_bereinigen")
arLR = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
arLC = .Cells(1, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row)
End With
With ActiveSheet                    ' Sheets("Daten")
arQ = .Cells(1, 1).CurrentRegion
For rr = 1 To UBound(arQ)
For cc = 1 To UBound(arQ, 2)
If IsArray(arLR) Then
For ii = 2 To UBound(arLR)
If Not IsEmpty(arLR(ii, 1)) Then
If arQ(rr, cc) = arLR(ii, 1) Then
If rngR Is Nothing Then
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
End If
End If
Next ii
End If
' ------------------------------------------------------------- neu
If IsEmpty(arQ(rr, cc)) Then  ' auch Zeilen, in dene eine leere
If rngR Is Nothing Then    '    Zelle steht, werden gelöscht
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
End If
If IsArray(arLC) Then
For ii = 2 To UBound(arLC)
If Not IsEmpty(arLC(ii, 1)) Then
If arQ(rr, cc) = arLC(ii, 1) Then
If rngC Is Nothing Then
Set rngC = .Columns(cc)
Else
Set rngC = Union(rngC, .Columns(cc))
End If
End If
End If
Next ii
End If
Next cc
Next rr
End With
If Not rngR Is Nothing Then rngR.Delete
If Not rngC Is Nothing Then rngC.Delete
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: VBA - Zeilen selektiv löschen
14.08.2014 09:12:28
Lammi
Hallo Erich,
das Makro läuft durch, löscht aber fast alle Zeilen.
Ich vermute das die Reihenfolge der Abarbeitung das Problem sein könnte.
Das SelektivLoeschen2 läuft.
Ich bin der Meineung dass das Makro 2 erst die Tabelle abarbeiten muss um dann nachgeschaltet die letzte Bedingung zu prüfen.
Es gibt Tabellen in dem die Spalten nur eine Kopfzeile beinhaltet und die restlichen Zeilen keinen Inhalt haben. Diese, so vermutet ich, verursachen dann wohl das alle anderen Datenzeilen gelöscht werden.
Deshalb meine ich, dass das Makro2 durchlaufen sollte wie es ist und erst dann die ditte Abfrage gestratet werden sollte.
Könntest Du das Makro umstellen oder ggf. auch trennen?
Gruß
Lammi

Anzeige
Aufgabe unklar
14.08.2014 10:08:00
Erich
Hi,
nun verstehe ich nicht mehr, was du möchtest und was jetzt falsch läuft.
Oben hast du geschrieben:
Es sollen alle Zeilen gelöscht werden die unvollständig sind.
Anzahl der gefüllten Kopfzeile (A1-...) ≠ Anzahl der Daten

und
Es werden alle Zeilen mit der nachfolgenden Bedingung verbleiben.
Anzahl der Kopfzeilen = Anzahl der gefüllten Datenzellen.

Nn schreibst du von
Tabellen in dem die Spalten nur eine Kopfzeile beinhaltet und die restlichen Zeilen keinen Inhalt haben.
Damit wird doch die obige Bedingung erfüllt - die Anzahl Daten ist 0 und damit kleiner als die Anzahl der Kopfzellen -
und das führt zur Löschung der jeweiligen Zeile.
Oder meintest du das anders?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
BeiSpielMappe
14.08.2014 10:53:47
Erich
Hi,
vielleicht kann diese Mappe zur Klärung beitragen. Die rot markierten Zeilen/Spalten werden gelöscht,
weil gelb bzw. braun gefunden werden oder die blauen Zellen leer sind.
https://www.herber.de/bbs/user/92096.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: BeiSpielMappe
14.08.2014 12:08:01
Lammi
Hallo Erich,
ich habe nochmal eine Beispeildatei erzeugt.
https://www.herber.de/bbs/user/92101.xlsm
Hier wird deutlich wenn das Makro3 gesartet wird ergibt es ein anders Ergebnis als wenn ich erst das Makro 2 und dann das Makro3 starte.
wie geschrieben ich benötige eine bestimmte Reihenfolge.
Gruß
Lammi

Anzeige
neue Version
14.08.2014 13:08:40
Erich
Hi,
jetzt habe ich es wohl verstanden... -):
Wenn eine Spalte gelöscht wird, sollen die Daten dieser Spalte (Treffer oder leere Zellen)
keinen Einfluss auf die Löschung der jeweiligen Zeilen haben.
Die Daten einer gelöschten/zu löschenden Spalte werden also bei der Zeilenprüfung nicht beachtet.
Probier das mal:

Sub SelektivLoeschen4()
Dim arLR, arLC, arQ, rr As Long, cc As Long, ii As Long, rngR As Range, rngC As Range
Dim oColDel As Object
Set oColDel = CreateObject("Scripting.Dictionary")             ' neu
With Sheets("Daten_bereinigen")
arLR = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
arLC = .Cells(1, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row)
End With
With ActiveSheet                    ' Sheets("Daten")
arQ = .Cells(1, 1).Resize(LZWeTab(Sheets(.Name)), _
.Cells(1, .Columns.Count).End(xlToLeft).Column)
For rr = 1 To UBound(arQ)
For cc = 1 To UBound(arQ, 2)
If IsArray(arLC) Then
For ii = 2 To UBound(arLC)
If Not IsEmpty(arLC(ii, 1)) Then
If arQ(rr, cc) = arLC(ii, 1) Then
oColDel(cc) = 0                           ' neu
If rngC Is Nothing Then
Set rngC = .Columns(cc)
Else
Set rngC = Union(rngC, .Columns(cc))
End If
End If
End If
Next ii
End If
If Not oColDel.Exists(cc) Then                        ' neu
If IsArray(arLR) Then
For ii = 2 To UBound(arLR)
If Not IsEmpty(arLR(ii, 1)) Then
If arQ(rr, cc) = arLR(ii, 1) Then
If rngR Is Nothing Then
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
End If
End If
Next ii
End If
If IsEmpty(arQ(rr, cc)) Then  ' auch Zeilen, in dene eine leere
If rngR Is Nothing Then    '    Zelle steht, werden gelöscht
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
End If
End If                                                ' neu
Next cc
Next rr
End With
If Not rngR Is Nothing Then rngR.Delete
If Not rngC Is Nothing Then rngC.Delete
End Sub
Function LZWeTab(wks As Worksheet) As Long
Dim rng As Range
With wks
Set rng = .Cells.Find("*", .Cells(1, 1), xlValues, , xlByRows, xlPrevious)
If rng Is Nothing Then LZWeTab = 1 Else LZWeTab = rng.Row
End With
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Version 5
15.08.2014 06:39:50
Erich
Hi Lammi,
so läuft es etwas schneller und runder:

Sub SelektivLoeschen5()
Dim arLR, arLC, arQ, rr As Long, cc As Long, ii As Long, rngR As Range, rngC As Range
Dim oColDel As Object, oRowDel As Object
Set oColDel = CreateObject("Scripting.Dictionary")
Set oRowDel = CreateObject("Scripting.Dictionary")             ' neu
With Sheets("Daten_bereinigen")
arLR = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
arLC = .Cells(1, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row)
End With
With ActiveSheet                    ' Sheets("Daten")
arQ = .Cells(1, 1).Resize(LZWeTab(Sheets(.Name)), _
.Cells(1, .Columns.Count).End(xlToLeft).Column)
For rr = 1 To UBound(arQ)
For cc = 1 To UBound(arQ, 2)
If oColDel.Exists(cc) Then Stop
If Not oColDel.Exists(cc) Then
If IsArray(arLC) Then
For ii = 2 To UBound(arLC)
If Not IsEmpty(arLC(ii, 1)) Then
If arQ(rr, cc) = arLC(ii, 1) Then         ' Treffer Spalte
If rngC Is Nothing Then
Set rngC = .Columns(cc)
Else
Set rngC = Union(rngC, .Columns(cc))
End If
oColDel(cc) = 0
End If
End If
Next ii
End If
If Not oRowDel.Exists(rr) Then                     ' neu
If IsArray(arLR) Then
For ii = 2 To UBound(arLR)
If Not IsEmpty(arLR(ii, 1)) Then
If arQ(rr, cc) = arLR(ii, 1) Then      ' Treffer Zeile
If rngR Is Nothing Then
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
oRowDel(rr) = 0                     ' neu
End If
End If
Next ii
End If
End If
If Not oRowDel.Exists(rr) Then                     ' neu
If IsEmpty(arQ(rr, cc)) Then  ' auch Zeilen, in dene eine leere
If rngR Is Nothing Then    '    Zelle steht, werden gelöscht
Set rngR = .Rows(rr)
Else
Set rngR = Union(rngR, .Rows(rr))
End If
oRowDel(rr) = 0                              ' neu
End If
End If
End If                                                ' neu
Next cc
Next rr
End With
If Not rngR Is Nothing Then rngR.Delete
If Not rngC Is Nothing Then rngC.Delete
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende allerseits!

Anzeige
Version 5 - Korrektur
15.08.2014 07:49:09
Erich
Hi Lammi,
in Version 5 steht eine Testanweisung, die noch raus muss, ziemlich weit oben im Code die Zeile
If oColDel.Exists(cc) Then Stop
ist für den realen Betrieb nicht so sinnvoll...
Bei 5000 Quelldatensätzen braucht es ca. 7 Sekunden.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: neue Version
15.08.2014 07:20:08
Lammi
Hallo Erich,
das Marko funktioniert. Ich habe bei den realen Daten eine Zeitprobelm bekommen.
Ich habe nun ca.5000 Datensätze getestet.
Marko2 arbeitet sehr gut setzt ich das Makro 4 ein gibt es klein Ende. Nach mehr mehren Minuten habe ich alles abgebrochen.
Gibt es da noch andere Möglichkeiten?
Bisher habe ich Leerzellen manuell gelöscht. Ich habe mir ein Spalte mit den meisten Leerzellen gefiltert und die gefilterten Daten neu abgesetzt.
Währe das ggf. eine neuer Ansatz?
Nach Ablauf des Makro2 : ...suche die Spalte mit den meisten Leerzellen und lösche alle Datenzeilen mit den Leerzellen.
Gruß
Lammi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige