Code zu rechenintensiv -> Alternative?!

Hallo zusammen,
ich habe einen Code geschrieben, der unter bestimmten Bedingungen genau die Mengen aufsummieren soll, bei denen diese Bedingungen erfüllt sind. Hierzu habe ich mir zunächst zum Testen einen Dummy-Datensatz gebaut, bei dem der Code auch einwandfrei läuft.
Der eigentliche Datensatz, über den der Code laufen soll, ist allerdings um ein vielfaches größer (326.665 Zeilen). Sobald ich den Code über diesen Datensatz laufen lasse, hängt sich Excel nach einigen Sekunden auf und liefert außerdem nur die ersten beiden Ergebnisse korrekt. Alle darauffolgenden Ergebnisse sind =0.
Deshalb meine Frage: Gibt es eine effizientere Alternative zu meinem Code und woran könnte es liegen, dass bei der Analyse des eigentlichen Datensatzes nur die ersten beiden Ergebnisse korrekt sind?
Hier der Code:
Option Explicit

Private Sub Workbook_Open() Range("B2:C1048576").ClearContents Dim n As Long Dim i As Long Dim Quantity_9010 As Long Dim Quantity_9016 As Long Dim year As Long Dim month As Integer Dim Datum As Date Dim zeile As Integer Quantity_9010 = 0 Quantity_9016 = 0 n = Sheets("Database").Cells(Rows.Count, 1).End(xlUp).Row zeile = 2 'Äusserste Schleife deckt die Jahre ab For year = 2019 To 2020 Step 1 'Nächste Schleife macht die Monate For month = 1 To 12 Step 1 If month = 10 Then Datum = month & "." & year End If zeile = Sheets("Auswertung_GBD").Cells(Rows.Count, 2).End(xlUp).Row + 1 'Tabelleninhalt ist ab 2. Zeile relevant, deshalb =2 For i = 2 To n 'Schleife zum Filtern der relevanten Zeilen und Aufsummieren der Mengen If ( _ Sheets("Database").Cells(i, 4).Value = "Kriterium_1" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_2" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_3" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_4" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_5" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_6" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_7") _ And ( _ Sheets("Database").Cells(i, 10).Value = "A" Or _ Sheets("Database").Cells(i, 10).Value = "B") _ And Sheets("Database").Cells(i, 1).Value = Datum Then 'Aufsummieren der Mengen Quantity_9010 = Quantity_9010 + Sheets("Database").Cells(i, 16).Value 'Schleife zum Filtern der relevanten Zeilen und Aufsummieren der Mengen ElseIf ( _ Sheets("Database").Cells(i, 4).Value = "Kriterium_8" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_9" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_10" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_11" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_12" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_13" Or _ Sheets("Database").Cells(i, 4).Value = "Kriterium_14") _ And ( _ Sheets("Database").Cells(i, 10).Value = "A" Or _ Sheets("Database").Cells(i, 10).Value = "B") _ And Sheets("Database").Cells(i, 1).Value = Datum Then 'Aufsummieren der Mengen Quantity_9016 = Quantity_9016 + Sheets("Database").Cells(i, 16).Value End If Next i Sheets("Auswertung_GBD").Cells(zeile, 3) = Quantity_9016 Sheets("Auswertung_GBD").Cells(zeile, 2) = Quantity_9010 Quantity_9016 = 0 Quantity_9010 = 0 Next month Next year End Sub

Vielen Dank schon einmal vorab!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
teste mal:

Option Explicit

Private Sub Workbook_Open()

Dim n As Long
Dim i As Long

Dim Quantity_9010 As Long
Dim Quantity_9016 As Long

Dim year As Long
Dim month As Integer
Dim Datum As Date

Dim zeile As Long

Dim avntValues As Variant

With Worksheets("Auswertung_GBD")
    .Range(.Cells(2, 2), .Cells(.Rows.Count, 3)).ClearContents
End With

With Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
    avntValues = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 16)).Value2
End With

zeile = 2

'Äusserste Schleife deckt die Jahre ab
For year = 2019 To 2020 Step 1

    'Nächste Schleife macht die Monate
    For month = 1 To 12 Step 1

        Datum = Format$(month, "00") & "." & CStr(year)

        'Tabelleninhalt ist ab 2. Zeile relevant, deshalb =2
        For i = LBound(avntValues) To UBound(avntValues)

            'Schleife zum Filtern der relevanten Zeilen und Aufsummieren der Mengen

            If avntValues(i, 1) = Datum Then

                If avntValues(i, 10) = "A" Or avntValues(i, 10) = "B" Then

                    If avntValues(i, 4) = "Kriterium_1" Or _
                        avntValues(i, 4) = "Kriterium_2" Or _
                        avntValues(i, 4) = "Kriterium_3" Or _
                        avntValues(i, 4) = "Kriterium_4" Or _
                        avntValues(i, 4) = "Kriterium_5" Or _
                        avntValues(i, 4) = "Kriterium_6" Or _
                        avntValues(i, 4) = "Kriterium_7" Then

                        Quantity_9010 = Quantity_9010 + avntValues(i, 16)

                        ElseIf avntValues(i, 4) = "Kriterium_8" Or _
                            avntValues(i, 4) = "Kriterium_9" Or _
                            avntValues(i, 4) = "Kriterium_10" Or _
                            avntValues(i, 4) = "Kriterium_11" Or _
                            avntValues(i, 4) = "Kriterium_12" Or _
                            avntValues(i, 4) = "Kriterium_13" Or _
                            avntValues(i, 4) = "Kriterium_14" Then

                            Quantity_9016 = Quantity_9016 + avntValues(i, 16)

                        End If
                    End If
                End If
            Next i

            Worksheets("Auswertung_GBD").Cells(zeile, 3) = Quantity_9016
            Worksheets("Auswertung_GBD").Cells(zeile, 2) = Quantity_9010

            Quantity_9016 = 0
            Quantity_9010 = 0
            zeile = zeile + 1

        Next month
    Next year
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Code zu rechenintensiv -> Alternative?!

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread