Microsoft Excel

Herbers Excel/VBA-Archiv

VBA - Makro ist ungewöhnlich langsam

Betrifft: VBA - Makro ist ungewöhnlich langsam von: Josef
Geschrieben am: 07.12.2015 15:03:02

Hallo allerseits,

ich habe folgendes Makro geschrieben:

Sub Test()

Dim Zelle As Range
Dim Letzte As Long

With Application
  .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

With ActiveSheet.UsedRange
  For i = .Rows.Count To 2 Step -1
    If .Cells(i, 1) = "" Then
      .Cells(i, 1).EntireRow.Delete
    End If
  Next i
End With

Letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

For Each Zelle In ActiveSheet.Range("A1:A" & Letzte)
    If Zelle.Value = "Buchungsdatum" Then
        Zelle.EntireRow.Delete
    End If
Next Zelle

ActiveSheet.Range("F1:F" & Letzte).Select
    Selection.Replace What:="RST", Replacement:="Aufl. RST"

For Each Zelle In ActiveSheet.Range("G1:G" & Letzte)
Zelle.Value = Zelle.Value * (-1)
Next

Range("A1").Select

With Application
  .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With

End Sub

Dieses Makro soll:
  • alle leeren Reihen löschen

  • Reihen in denen in A das Wort "Buchungsdatum" steht löschen

  • Das Wort "RST" in Spalte F durch "Aufl. RST" ersetzen

  • Und die Vorzeichen in Spalte G umkehren (durch Multiplikation mit -1)


  • Funktioniert auch alles, nur lässt sich das Makro dabei unerwartet viel Zeit. Ich habe komplexere Makros gesehen, welche deutlich schneller durchliefen.
    Stimmt etwas mit meinem Code nicht? Kann man ihn optimieren?

    Beste Grüße

    Josef

      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Rudi Maintaire
    Geschrieben am: 07.12.2015 15:16:52

    Hallo,
    ungetestet:

    Sub Test()
      
      Dim rngDel As Range
      Dim i As Long
      
      With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
      End With
      
      With ActiveSheet
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
          If .Cells(i, 1) = "" Or Cells(i, 1) = "Buchungsdatum" Then
            If rngDel Is Nothing Then
              Set rngDel = .Cells(i, 1)
            Else
              Set rngDel = Union(rngDel, .Cells(i, 1))
            End If
          Else
            If .Cells(i, 6) = "RST" Then .Cells(i, 6) = "Aufl. RST"
            .Cells(i, 7) = .Cells(i, 7) * -1
          End If
        Next i
      End With
      If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
      Range("A1").Select
      
      With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
      End With
      
    End Sub
    Gruß
    Rudi


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Josef
    Geschrieben am: 07.12.2015 15:34:32

    Danke Rudi, läuft deutlich schneller.


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Josef
    Geschrieben am: 07.12.2015 16:32:58

    Hallo nochmal,

    mir ist leider aufgefallen, dass folgende Zeile nicht funktioniert:

     If .Cells(i, 6) = "RST" Then .Cells(i, 6) = "Aufl. RST"
    Nach Durchführung steht in Spalte 6 nach wie vor "RST".

    Eine Ergänzung um .Value ändert das nicht.

    Gruß

    Josef


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Rudi Maintaire
    Geschrieben am: 07.12.2015 16:37:34

    dann per replace.

          Else
            .Cells(i, 6).Replace "RST", "Aufl. RST"
            .Cells(i, 7) = .Cells(i, 7) * -1
          End If
    

    Gruß
    Rudi


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Josef
    Geschrieben am: 07.12.2015 16:48:45

    Hi Rudi,

    mir ist gerade aufgefallen dass ich vergessen habe, ein Detail zu erwähnen.

    In Spalte 6 steh nicht nur "RST" alleine. Das "RST" ist nur am Anfang des Strings - z.B. "RST Dienstleistung".
    Aus diesem soll "Aufl. RST Dienstleistung" werden.

    Sorry für das Vergessen.

    Durch

    .Cells(i, 6).Replace "RST*", "Aufl. RST"
    lässt es sich leider nicht beheben, da der Rest des Strings überschrieben wird.

    Gruß

    Josef


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Werner
    Geschrieben am: 07.12.2015 16:55:59

    Hallo Josef,

    und wie sieht es mit

     If .Cells(i, 6) = "RST*" Then .Cells(i, 6) = "Aufl. RST Dienstleistung"
    Gruß Werner


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Josef
    Geschrieben am: 07.12.2015 17:00:56

    Hallo Werner,

    das mit "Dienstleistung" war nur ein Beispiel, im Grunde kann alles mögliche hinter "RST" stehen.
    Ich habe es jetzt aber gelöst:

    .Cells(i, 6).Value = "Aufl. " & Cells(i, 6).Value
    Das "Aufl. " wird einfach vor den String gesetzt. Kein Ersetzen mehr.

    Gruß und schönen Abend

    Josef


      

    Betrifft: AW: VBA - Makro ist ungewöhnlich langsam von: Daniel
    Geschrieben am: 07.12.2015 15:47:56

    Hi
    ja, kann man deutlich optimieren, das geht auch ohne VBA deutlich schneller, denn unter Nutzung der Excelfunktionen muss man nicht jede Zeile einzeln bearbeiten.


    geht so:
    a) Zeilen löschen mit Bedingung:
    - füge am Tabellenende (erste freie Spalte) eine Formel ein, welche alle zu löschenden Zeilen mit 0 kennzeichnet und die die stehenbleiben sollen mit der aktuellen Zeilennummer
    - schreibe in die Überschriftenzeile dieser Spalte die 0
    - wende auf die ganze Spalte die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an, mit der Hilfsspalte als Kriterium

    b) Vorzeichen umkehren
    - schreibe in eine Leerzelle den Wert -1
    - kopiere diese Zelle
    - markiere alle Zellen die umgewandelt werden sollen und führe aus INHALTE EINFÜGEN - WERTE - VORGANG: MULTIPLIZIEREN

    alles, was man in Excel von Hand machen kann, kann man dann auch in VBA nachprogrammieren und das sieht für deine Datei so aus:

    Sub test()
    With ActiveSheet.UsedRange
        '--- Zeilen löschen
        With .Columns(.Columns.Count + 1)
            .FormulaR1C1 = "=IF(OR(RC1="""",RC1=""Buchungsdatum""),0,Row())"
            .Cells(1, 1).Value = 0
            .EntireRow.RemoveDuplicates .Column, xlNo
            .ClearContents
        End With
        
        '--- Text ergänzen
        .Columns(6).Replace "RST", "Aufl. RST", xlWhole
        
        
        '--- Vorzeichen wechseln
        .Cells(1, .Columns.Count + 1).Value = -1
        .Cells(1, .Columns.Count + 1).Copy
        .Columns(7).SpecialCells(xlCellTypeConstants, 1).PasteSpecial xlPasteValues, operation:= _
    xlMultiply
        Application.CutCopyMode = False
        .Cells(1, .Columns.Count + 1).ClearContents
    End With
    End Sub
    Gruß Daniel


      

    Betrifft: AW: VBA -kleine Korrektur von: Daniel
    Geschrieben am: 07.12.2015 17:13:46

    Hi

    da RST ein Teiltext ist, mach folgende Korrektur:

    '--- Text ergänzen
    .Columns(6).Replace "RST", "Aufl. RST", xlPart, MatchCase:=True


    gruß Daniel


     

    Beiträge aus den Excel-Beispielen zum Thema "VBA - Makro ist ungewöhnlich langsam"