Schnellere Alternative zur For-Schleife

  • Excel

Es gibt 13 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Schnellere Alternative zur For-Schleife

    Hallo,

    ich habe ein kleines Problem mit meinem Code. Leider dauert die Ausführung etwas zu lange.

    Also ich habe in Excel 3 Spalten befüllt (ca. 35000 Zeilen).

    Spalte A: Datum
    Spalte B: Uhrzeit
    Spalte C: Wert

    Jetzt möchte ich z.B. alle Datums, Uhrzeiten und Werte von den Monaten Sept., Okt. und Nov. in ein neues Tabellenblatt schreiben. Im neuen Tabellenblatt sollen diese dann noch sortiert werden und Duplikate geloscht werden. Aber das geht eigentlich ganz zackig. Was aber m.E. aufhält ist das Einfügen in ein neues Tabellenblatt.

    Anbei mein Codeausschnitt:

    Visual Basic-Quellcode

    1. 'HERBST
    7. zei = 0
    13. For Wiederholungen = 1 To Worksheets.Count
    16. If Sheets(Wiederholungen).Name = "Herbst" Then Blatt_vorhanden = True
    19. Next
    22. If Blatt_vorhanden = False Then
    25. With Worksheets.Add(Sheets(1))
    28. .Name = "Herbst"
    31. End With
    34. End If
    37. Sheets("Herbst").Columns("A").NumberFormat = "m/d/yyyy"
    40. Sheets("Herbst").Columns("B").NumberFormat = "hh:mm:ss;@"
    43. Sheets("Herbst").Columns("C").NumberFormat = "#,##0"
    46. Sheets("Herbst").Columns("A:Z").Font.Size = 8
    49. Sheets("Herbst").Columns("A:Z").Font.Name = "Arial"
    52. With Worksheets("Quelle")
    55. For n = 3 To .range("a65536").End(xlUp).Row
    58. If Month(.Cells(n, "a")) = 9 Then
    61. zei = zei + 1
    64. Worksheets("Herbst").Cells(zei + 1, "a") = .Cells(n, "a")
    67. Worksheets("Herbst").Cells(zei + 1, "b") = .Cells(n, "b")
    70. Worksheets("Herbst").Cells(zei + 1, "c") = .Cells(n, "c")
    73. End If
    76. If Month(.Cells(n, "a")) = 10 Then
    79. zei = zei + 1
    82. Worksheets("Herbst").Cells(zei + 1, "a") = .Cells(n, "a")
    85. Worksheets("Herbst").Cells(zei + 1, "b") = .Cells(n, "b")
    88. Worksheets("Herbst").Cells(zei + 1, "c") = .Cells(n, "c")
    91. End If
    94. If Month(.Cells(n, "a")) = 11 Then
    97. zei = zei + 1
    100. Worksheets("Herbst").Cells(zei + 1, "a") = .Cells(n, "a")
    103. Worksheets("Herbst").Cells(zei + 1, "b") = .Cells(n, "b")
    106. Worksheets("Herbst").Cells(zei + 1, "c") = .Cells(n, "c")
    109. End If
    112. Next n
    115. End With


    Gibt es hier eine bessere bzw. schnellere Alternative?

    Danke, Gruß MArtin.



    Edit by Dodo:
    -> Topic verschoben (Grundlagen => VBA)

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Dodo“ ()

    generell kannste die drei Abfragen schon mal zu einer zusammenfassen, dann musste nich 3mal das ganze blatt absuchen:

    Visual Basic-Quellcode

    1. If Month(.Cells(n, "a")) = 9 ORelse Month(.Cells(n, "a")) = 10 ORelse Month(.Cells(n, "a")) = 11 then
    2. '...kopieren
    3. end if

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „FloFuchs“ ()

    @Maig: For ist schnell, was Du damit machst, ist langsam.
    @FloFuchs: Or ==> OrElse ist auch performanter.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    @FloFuchs: Dann sind wir im falschen Forum gelandet. :S
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    3. Sub herbst()
    4. Dim wb As Workbook 'Direkte Bezüge zu den Workbooks und Worksheets herstellen erleichtert die Arbeit
    5. Set wb = ThisWorkbook
    6. Dim wsZiel, wsQuelle As Worksheet
    7. Set wsQuelle = wb.Worksheets("Quelle")
    9. If Not (WorksheetExists("Herbst", wb)) Then 'guggen ob das Sheet existiert wenn nich erstellen
    10. Set wsZiel = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
    11. ws.Name = "Herbst"
    12. Else
    13. Set wsZiel = wb.Worksheets("Herbst")
    14. End If
    16. With wsZiel 'Sheet formatieren - wobei ich persönlich mir da meist versteckte Vorlagensheets in den Dateien anlege muss man nur einmal ändern
    17. .Columns("A").NumberFormat = "m/d/yyyy"
    18. .Columns("B").NumberFormat = "hh:mm:ss;@"
    19. .Columns("C").NumberFormat = "#,##0"
    20. .Columns("A:Z").Font.Size = 8
    21. .Columns("A:Z").Font.Name = "Arial"
    22. End With
    25. wsQuelle.Sort.SortFields.Clear 'sortieren deines Datumsbereiches
    26. wsQuelle.Sort.SortFields.Add Key:=Range("A1"), _
    27. SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    28. With wsQuelle.Sort
    29. .SetRange Range("A:C") 'der Sortierbereich - die ersten 3 Spalten
    30. .Header = xlNo
    31. .MatchCase = False
    32. .Orientation = xlTopToBottom
    33. .SortMethod = xlPinYin
    34. .Apply
    35. End With
    37. With wsQuelle
    38. Dim rng As Range
    39. Dim rngAnfang, rngEnde As Range
    40. Dim StartEnde As Integer
    41. For Each rng In .Range("A:A") 'erstes Vorkommen vom September suchen
    42. If Month(rng.Value) = 9 Then
    43. rngAnfang = rng
    44. StartEnde = rng.Row
    45. Exit For
    46. End If
    47. Next rng
    49. Dim i As Integer 'letztes Vorkommen vom November suchen
    50. For i = .Range.Rows(StartEnde) To .Range.Rows.Count
    51. If Month(Cells(i, 1).Value) = 11 And (Month(Cells(i, 1).Offset(1, 0).Value) = 12 Or Month(Cells(i, 1).Offset(1, 0).Value) = Nothing) Then
    52. rngEnde = Range(Cells(i, 1))
    53. Exit For
    54. End If
    55. Next i
    57. Dim rngKopieren As Range 'Quellbereich definieren
    58. Set rngKopieren = .Range(rngAnfang, rngEnde.Offset(0, 2))
    59. rngKopieren.Copy
    60. .Range("A1").PasteSpecial 'und im Zielsheet ab "A1" einfügen
    61. End With
    62. End Sub
    63. Public Function WorksheetExists(ByVal IWorkSheetName As String, ByVal IWorkBook As Workbook) As Boolean
    64. Dim IWorkSheet As Worksheet 'function zum testen ob ein Worksheet in einem Workbook vorhanden ist
    65. For Each IWorkSheet In IWorkBook
    66. If IWorkSheet.Name = IWorkSheetName Then
    67. WorksheetExists = True
    68. Exit For
    69. Else
    70. WorksheetExists = False
    71. End If
    72. Next
    73. End Function

    Vielen Dank für deinen Code.

    Aber wie kann ich den denn am einfachsten testen, damit ich ihn bei mir einbauen kann?

    Hab jetzt eine neue Datei geöffnet mit meinen Werten in Tabellenblatt "Quelle" und lass das Programm laufen.

    Aber ich hab schon bei Zeile 11 einen Fehler:
    "Variable nicht definiert"

    Sollte der so wie er ist fehlerfrei durchlaufen?

    Danke nochmal!