HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
"Hübscherer" Code möglich?
Tanja

Guten Morgen zusammen,
ich habe den folgenden Code "entworfen" und würde gerne wissen, on man den auch schöner schreiben kann. Oder eher gesagt, ob die Schleife besser gemacht werden kann. Selbst für 3000 Durchläufe braucht das Makro schon ein wenig Zeit.
Im Prinzip will ich aber nicht wirklich 3000 mal durchlaufen, sondern eigentlich alle Datensätze bis ans Ende prüfen, ob unmittelbar untereinander identische Einträge in den Spalten G, H und I sind.
Hat jemand einen Vorschlag, wie ich den Code effizienter bekomme?
Wäre über euren Rat sehr dankbar.
Option Explicit
Sub zeilenloeschen()
Dim datesp  As Long ' DATE
Dim vorfsp  As Long ' Vorfallsdatum
Dim zeitpsp As Long ' Vorfallszeitpunkt
Dim gZeile  As Long ' gesuchte Zeile
Dim i
Sheets("3").Select
datesp = 7
vorfsp = 8
zeitpsp = 9
gZeile = 1
For i = 1 To 3000
If Cells(gZeile, datesp).Value = Cells(gZeile + 1, datesp).Value And Cells(gZeile, vorfsp). _
Value = Cells(gZeile + 1, vorfsp).Value And Cells(gZeile, zeitpsp).Value = Cells(gZeile + 1, zeitpsp).Value Then
Rows(gZeile).Delete
gZeile = gZeile + 1
Else
gZeile = gZeile + 2
End If
Next
End Sub
Viele Grüße
Tanja

AW: "Hübscherer" Code möglich?
Michael

Als erstes wird es richtig schnell wenn du die Bildschirm anzeige und Berechnung ausschaltest, dann merkt man nicht mal wenn 30000 Zeilen geprüft werden.
der Code dafür zum Ausschalten
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
zum wieder einschalten
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
AW: "Hübscherer" Code möglich?
Tanja

Hallo Michael,
vielen Dank für die fixe Antwort.
Ist der Code ansonsten so in Ordnung? Ich bin noch ein wenig skeptisch, weil das einer meiner ersten selbst erstellten Codes ist ;)
Viele Grüße
Tanja
AW: "Hübscherer" Code möglich?
Michael

wenn du keine 3000 zeilen hast,
kannst du DO ... LOOP verwenden, oder eine Spalte/Zeile prüfen in der IMMER ein Wert steht und dann mit Exit For aus der Schleife rausgspringen,
Ich verwende für eine Unbekannte Anzahl von Zeilen immer Do ... Loop und prüfe auf eine Zeile die bis zur letzten zu prüfenden zeile einen Wert enthält.
also
Do
..... hier DEIN Code rein
i=i+1
LOOP Until cells(Zeile, Spalte)=""
so in der Art...
Gruß
Michael
Klappt super. Danke! :-) owt
Tanja

VG
Tanja
Ja,..
Ramses

Hallo
Sieh dir das mal an
Sub zeilenloeschen()
    Dim datesp As Long ' DATE
    Dim vorfsp As Long ' Vorfallsdatum
    Dim zeitpsp As Long ' Vorfallszeitpunkt
    Dim i As Long
    'Select ist nicht nötig
    '"With"-Verweis reicht
    With Sheets("3")
        datesp = 7
        vorfsp = 8
        zeitpsp = 9
        'Zähle einfach vom letzten Eintrag in der Spalte nach oben
        'bei Löschaktionen immer vom Ende nach oben, dann musst du nicht die Zeilen zählen
        'und umständlich rechnen
        For i = .Cells(Rows.Count, datesp).End(xlUp).Row To 3
            If .Cells(i, datesp).Value = .Cells(i - 1, datesp).Value And _
                .Cells(i, vorfsp).Value = .Cells(i - 1, vorfsp).Value And _
                .Cells(i, zeitpsp).Value = .Cells(i - 1, zeitpsp).Value Then
                Rows(i).Delete
            End If
            'Else ist in diesem Fall nicht notwendig.
            'Entweder der eintrag ist doppelt oder nicht.
            'Zähler anpassen entfällt
        Next i
    End With
End Sub

Gruss Rainer
...aber eigentlich...
Ramses

Hallo
Wäre das wohl die schnellste und optimalste Variante
Sub zeilenloeschen()
    Dim datesp As Long ' DATE
    Dim vorfsp As Long ' Vorfallsdatum
    Dim zeitpsp As Long ' Vorfallszeitpunkt
    Dim i As Long
    'Darstellung und Berechnung ausschalten
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    'Select ist nicht nötig
    '"With"-Verweis reicht
    With Sheets("3")
        datesp = 7
        vorfsp = 8
        zeitpsp = 9
        'Zähle einfach vom letzten Eintrag in der Spalte nach oben
        'bei Löschaktionen immer vom Ende nach oben, dann musst du nicht die Zeilen zählen
        'und umständlich rechnen
        For i = .Cells(Rows.Count, datesp).End(xlUp).Row To 2
            'Prüfungs- / Geschwindigkeitsoptimierung
            'Trifft die erste Bedingung schon nicht zu, entfallen alle weiteren Prüfungen
            'Hier ist die Spalte einzutragen wo die häufigsten Doppler auftreten
            If .Cells(i, datesp).Value = .Cells(i - 1, datesp).Value Then
                '... und hier die Spalte mit den zweithäufigsten Dopplern
                If .Cells(i, vorfsp).Value = .Cells(i - 1, vorfsp).Value Then
                    '... die letzte Prüfung wenn die beiden vorherigen zutreffend waren
                    If .Cells(i, zeitpsp).Value = .Cells(i - 1, zeitpsp).Value Then
                        Rows(i).Delete
                    End If
                End If
            End If
            'Else ist in diesem Fall nicht notwendig.
            'Entweder der eintrag ist doppelt oder nicht.
            'Zähler anpassen entfällt
        Next i
    End With
    'Darstellung und Berechnung wieder einschalten
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Gruss Rainer
AW: ...aber eigentlich...
Tanja

Puuuuuh... da muss ich erstmal wieder durchblicken.
Ich danke dir für deinen Vorschlag, ich werd ihn mir mal verinnerlichen und im Anschluss übernehmen! :-)
VG
Tanja
AW: ...aber eigentlich...
Michael

Ich wollte es nicht zu komplizert machen :-)
ich finde das mit dem With macht es NICHT einfacher, da man immer schauen muss welches Blatt gemeint ist.
Da ihr Code ja lief und nur schneller sein sollte, ist das mit ScreenUpdating und Calaculation doch erstmal gemacht.
AW: ...aber eigentlich...
Ramses

Hallo
"...das mit dem With macht es NICHT einfacher..:"
Wo ist das Problem ?
Mit "With Worksheets("3")" beziehen sich ALLE Referenzierungen die im anschliessenden Code mit dem Punkt vorangestellt auf diese Tabelle. Da muss ich doch nichts mehr nachsehen.
Und die Tabelle muss noch nicht mal selektiert werden.
Das mit ScreenUpdating und Calculation ist sicher richtig, aber richtig Zeit nehmen die Prüfungen in Anspruch. Hier werden für jede Zeile 3 Prüfungen vorgenommen. Bei 3000 Zeilen sind das 9000 Prüfungen plus 3000 ELSE-Anweisungen. Wenn die erste Prüfung schon nicht stimmt und der Rest wegfällt, kann ich die Prüfungen u.U. auf deutlich weniger als 3000 bringen und die ELSE Bedingung fält auch noch weg :-)
Gruss Rainer