Microsoft Excel

Herbers Excel/VBA-Archiv

"Hübscherer" Code möglich? | Herbers Excel-Forum


Betrifft: "Hübscherer" Code möglich? von: Tanja
Geschrieben am: 16.12.2009 08:16:43

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

  

Betrifft: AW: "Hübscherer" Code möglich? von: Michael
Geschrieben am: 16.12.2009 08:37:38

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


  

Betrifft: AW: "Hübscherer" Code möglich? von: Tanja
Geschrieben am: 16.12.2009 08:40:25

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


  

Betrifft: AW: "Hübscherer" Code möglich? von: Michael
Geschrieben am: 16.12.2009 08:49:59

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


  

Betrifft: Klappt super. Danke! :-) owt von: Tanja
Geschrieben am: 16.12.2009 09:02:45

VG
Tanja


  

Betrifft: Ja,.. von: Ramses
Geschrieben am: 16.12.2009 09:59:23

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


  

Betrifft: ...aber eigentlich... von: Ramses
Geschrieben am: 16.12.2009 10:26:46

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


  

Betrifft: AW: ...aber eigentlich... von: Tanja
Geschrieben am: 16.12.2009 11:45:21

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


  

Betrifft: AW: ...aber eigentlich... von: Michael
Geschrieben am: 16.12.2009 12:07:23

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.


  

Betrifft: AW: ...aber eigentlich... von: Ramses
Geschrieben am: 16.12.2009 12:49:47

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


Beiträge aus den Excel-Beispielen zum Thema ""Hübscherer" Code möglich?"