Makro effizienter

Forumthread: Makro effizienter

Makro effizienter

11.01.2025 19:38:45

Fred

Hallo Excel Profis,
ich habe vor langer Zeit ein Makro von Onur bekommen welches fehlerfrei abarbeitet.

Sub summe_Treffer_10spiele_zuvor()

Application.ScreenUpdating = False

    Dim z, treffer, lz, zz, anf, x

    anf = 2 ' ab Zeile 2

    lz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    For z = anf To lz

        treffer = 0: x = 0

        For zz = z + 1 To lz

            If Cells(zz, 2) = Cells(z, 2) Then

                treffer = treffer + Cells(zz, 5)

                x = x + 1: If x = 10 Then Exit For

            End If

        Next zz

        Cells(z, 14) = treffer

    Next z

End Sub

Nun will ich es in einer Tabelle ausführen lassen, welcher über 60000 Zeilen hat,- nach 10 Minuten breche ich ab ....
Kann dieses Makro noch effizienter geschrieben werden,- kürzere Zeit auf 60000 Zeilen?

Gruss
Fred

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro effizienter

11.01.2025 19:45:33

Onur
AW: Makro effizienter

12.01.2025 01:41:24

Onur
AW: Makro effizienter

12.01.2025 09:24:20

Oberschlumpf
AW: Makro effizienter

12.01.2025 12:39:25

Onur
AW: Makro effizienter

12.01.2025 12:48:20

Onur
AW: Makro effizienter

12.01.2025 12:54:20

Onur
AW: Makro effizienter

11.01.2025 20:00:01

Fred
AW: Makro effizienter

11.01.2025 20:16:39

Uduuh
AW: Makro effizienter

11.01.2025 20:29:53

Fred
AW: Makro effizienter

11.01.2025 21:17:14

Fred
kannst du so machen. owT

11.01.2025 21:59:53

Uduuh

AW: Makro effizienter

11.01.2025 19:45:33

Onur

Poste bitte auch die (eine) passende Datei dazu inkl einer Erklärung, WAS da berechnet werden soll.

AW: Makro effizienter

12.01.2025 01:41:24

Onur

Hi, Fred

Wären 5 sec für über 100.000 Datensätze schnell genug ?

Gruß
Onur

AW: Makro effizienter

12.01.2025 09:24:20

Oberschlumpf

Hi Onur,

ich bin zwar nicht Fred, aber mich würd dein "sehr-schnell-Code" :-) auch sehr interessieren.
Zeigst du uns den Code bitte?

Ciao
Thorsten

AW: Makro effizienter

12.01.2025 12:39:25

Onur

Sub summe_Treffer_10spiele_zuvor()

    Dim dict, ar, i, sum

    Dim z, lz, anf, Team, Tore

    Dim ti

    Application.ScreenUpdating = False

    ti = Timer

    ReDim ar(1, 0)

    Set dict = CreateObject("Scripting.Dictionary")

    anf = 2 ' ab Zeile 2

    lz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    For z = anf To lz

        Team = Cells(z, 2).Value: Tore = Cells(z, 5).Value

        If dict.exists(Team) Then

            ar = dict(Team)

            i = UBound(ar, 2)

            ReDim Preserve ar(1, i + 1)

            ar(0, i + 1) = z

            ar(1, i + 1) = Tore

            dict(Team) = ar

        Else

            ar(0, 0) = z

            ar(1, 0) = Tore

            dict.Add Team, ar

        End If

    Next z

    For z = anf To lz

        ar = dict(Cells(z, 2).Value)

        ix = UBound(ar, 2)

        sum = 0: ii = 0

        For i = 0 To ix

            If ar(0, i) > z And ii  10 Then

                sum = sum + ar(1, i)

                ii = ii + 1

            End If

        Next

        Cells(z, 17) = sum

    Next z

    Application.ScreenUpdating = True

    MsgBox Timer - ti

End Sub

AW: Makro effizienter

12.01.2025 12:48:20

Onur

Hi Thorsten,

es wird diesmal (zum Vergleich) in Spalte J eingetragen.

Gruß
Onur

AW: Makro effizienter

11.01.2025 20:00:01

Fred

Hallo Onur,- frohes und gesundes Neues Jahr !!
ich will die Heimtreffer zählen, welche das Heimteam die 10 Spiele zuvor erzielt hat.
Das Makro funzt.
Allerdings dauert es sehr sehr lange bei über 60 000 Zeilen
https://www.herber.de/bbs/user/174816.xlsb

Gruss
Fred

AW: Makro effizienter

11.01.2025 20:16:39

Uduuh

Hallo,
versuch mal:

Sub summe_Treffer_10spiele_zuvor()

    Dim vntTmp, vntTreffer

    Dim z, treffer, lz, zz, anf, x

    anf = 2 ' ab Zeile 2

    lz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    ReDim vntTreffer(1 To lz, 1 To 1)

    vntTreffer(1, 1) = Cells(1, 14)

    vntTmp = Range(Cells(1, 1), Cells(lz, 14))

    For z = anf To lz

        treffer = 0: x = 0

        For zz = z + 1 To lz

            If vntTmp(zz, 2) = vntTmp(z, 2) Then

                treffer = treffer + Cells(zz, 5)

                x = x + 1: If x = 10 Then Exit For

            End If

        Next zz

        vntTreffer(z, 1) = treffer

    Next z

    Cells(1, 14).Resize(lz) = vntTreffer

End Sub

Gruß aus'm Pott
Udo

AW: Makro effizienter

11.01.2025 20:29:53

Fred

huiiii,
nun werden 40 000 Datensätze in gut 1 Minute abgearbeitet.
Das ist natürlich akzeptabel und ein enormer Unterschied zur Vorgänger-Version.
Der wesentlich Unterschied liegt wohl in der Nutzung eines Arrays (vntTmp), die Ergebnisse werden in einem separaten Array (vntTreffer) zwischengespeichert und am Ende wird das gesamte Array auf einmal in die Excel-Tabelle geschrieben; Super :-)
Ich teste es noch weiter und wenn eine weitere Frage aufkommt, würde ich mich nochmals melden, OK ?

Gruss
Fred

AW: Makro effizienter

11.01.2025 21:17:14

Fred

und wenn ich nun nicht nur die Treffer aus den Heimspielen sondern auch von den Auswärtsspielen des Heimtams ermitteln will, dann:

Sub Heim_alle_10spiele_zuvor_Treffer()

    Dim vntTmp, vntTreffer

    Dim z As Long, treffer As Long, lz As Long, zz As Long, anf As Long, x As Long

    Dim ws As Worksheet



    Set ws = ThisWorkbook.Sheets("FBD_Data")



    anf = 2 ' Ab Zeile 2

    lz = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row



    ReDim vntTreffer(1 To lz, 1 To 1)

    vntTreffer(1, 1) = ws.Cells(1, 16)

    vntTmp = ws.Range(ws.Cells(1, 1), ws.Cells(lz, 16))



    For z = anf To lz

        treffer = 0: x = 0

        For zz = z + 1 To lz

            If vntTmp(zz, 2) = vntTmp(z, 2) Then

                treffer = treffer + ws.Cells(zz, 5)

                x = x + 1

            ElseIf vntTmp(zz, 3) = vntTmp(z, 2) Then

                treffer = treffer + ws.Cells(zz, 6)

                x = x + 1

            End If

            If x = 10 Then Exit For

        Next zz

        vntTreffer(z, 1) = treffer

    Next z

    ws.Cells(1, 16).Resize(lz) = vntTreffer

End Sub

so OK ?
wenn ja, dann vielen Dank für deine Kompetenz!!!

Gruss
Fred

kannst du so machen. owT

11.01.2025 21:59:53

Uduuh

Forumthread: Makro effizienter

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread