Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


VBA Performance Problem
#1
Hallo Zusammen,
der folgende Code läuft über eine Tabelle mit 40000 Zeilen und gibt Werte zurück welche in eine Form eingetragen werden. Leider geht hierbei die Performance zu sehr in die Knie. Dazu reichen meine VBA Kenntnisse nicht für einen besseren Code aus. Hat jemand eine Idee wie ich den Code umschreiben könnte damit die Performance besser wird?
Code:
Private Sub cmd_ums2014_Click()
Dim i3 As Double

For i3 = 1 To 40000
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "01" Then
    Frm_Start.txt_og1.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG1.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "02" Then
    Frm_Start.txt_og2.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG2.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "03" Then
    Frm_Start.txt_og3.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG3.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "04" Then
    Frm_Start.txt_og4.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG4.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "05" Then
    Frm_Start.txt_og5.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG5.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "06" Then
    Frm_Start.txt_og6.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG6.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "07" Then
    Frm_Start.txt_og7.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG7.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "08" Then
    Frm_Start.txt_og8.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG8.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "09" Then
    Frm_Start.txt_og9.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG9.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i3, 2) = "10" Then
    Frm_Start.txt_og10.Value = Worksheets("umsätze").Cells(i3, 3)
    Frm_Start.txt_2013_OG10.Value = Worksheets("umsätze").Cells(i3, 4)
    End If
Next
End Sub
to top
#2
Hi Mike,

(26.01.2015, 09:31)mikeho schrieb: Hat jemand eine Idee wie ich den Code umschreiben könnte damit die Performance besser wird?

versuche es mal so (ungetestet):
Code:
Private Sub cmd_ums2014_Click()
Dim i3 As Double

    With Worksheets("umsätze")
        For i3 = 1 To 40000
            If .Cells(i3, 1) = Me.txtDebnr Then
                Select Case .Cells(i3, 2).Value
                    Case "01"
                        Frm_Start.txt_og1.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG1.Value = .Cells(i3, 4)
                    Case "02"
                        Frm_Start.txt_og2.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG2.Value = .Cells(i3, 4)
                    Case "03"
                        Frm_Start.txt_og3.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG3.Value = .Cells(i3, 4)
                    Case "04"
                        Frm_Start.txt_og4.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG4.Value = .Cells(i3, 4)
                    Case "05"
                        Frm_Start.txt_og5.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG5.Value = .Cells(i3, 4)
                    Case "06"
                        Frm_Start.txt_og6.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG6.Value = .Cells(i3, 4)
                    Case "07"
                        Frm_Start.txt_og7.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG7.Value = .Cells(i3, 4)
                    Case "08"
                        Frm_Start.txt_og8.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG8.Value = .Cells(i3, 4)
                    Case "09"
                        Frm_Start.txt_og9.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG9.Value = .Cells(i3, 4)
                    Case "010"
                        Frm_Start.txt_og10.Value = .Cells(i3, 3)
                        Frm_Start.txt_2013_OG10.Value = .Cells(i3, 4)
                End Select
            End If
        Next
    End With
End Sub

Dann muß nicht für jede Zelle i3 B jede IF-Schleife durchlaufen werden und falls i3 A nicht gleich der Me.txtDebnr ist, springt er auch sofort zur nexten Zeile.
Gruß Ralf

?mage

Die deutsche Rechtschreibung ist Freeware, d.h. du kannst sie kostenlos nutzen.
Allerdings ist sie nicht Open Source, deswegen darfst du sie nicht verändern oder in veränderter Form veröffentlichen.
to top
#3
Hallo,

ich würde hier mit der Find Methode arbeiten, nach folgendem Prinzip:

Code:
Dim rngZ As Range
For i = 1 To 10
   Set rngZ = Columns("A").Find(Format(i, "00"), LookIn:=xlValues, lookat:=xlWhole)
   If Not rngZ Is Nothing Then
      Frm_Start.Controls("txt_og" & i).Value = Worksheets("umsätze").Cells(rngZ.Row, 3)
      Frm_Start.Controls("txt_2013_OG" & i).Value = Worksheets("umsätze").Cells(rngZ.Row, 4)
   End If
Next i
Gruß Atilla

Excel 2007
to top
#4
Danke für die Tipps. Diese kommen auf alle Fälle in meine Code-Sammlung.
Ich habe es mittlerweile anders gelöst. Die Werte in Spalte 1 sind sortiert aufsteigend. Da er bei den ersten Treffer "zuschlägt" habe ich nur bei der ersten Schleife einen Lauf über alle 40.000 Datensätze gemacht. Die anderen starten bei an der im ersten Lauf gefunden Stelle und machen max. 11 Durchläufe, da es nicht mehr Datensätze sein können.

Code:
Private Sub cmd_ums2014_Click()
Dim i3 As Double
Dim i4 As Double
Dim zeile As Double



For i3 = 1 To 40000

    If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr Then
    zeile = i3

    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "01" Then
    Frm_Start.txt_og1.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG1.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "02" Then
    Frm_Start.txt_og2.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG2.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "03" Then
    Frm_Start.txt_og3.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG3.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "04" Then
    Frm_Start.txt_og4.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG4.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "05" Then
    Frm_Start.txt_og5.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG5.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "06" Then
    Frm_Start.txt_og6.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG6.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "07" Then
    Frm_Start.txt_og7.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG7.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "08" Then
    Frm_Start.txt_og8.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG8.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "09" Then
    Frm_Start.txt_og9.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG9.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    For i4 = zeile To zeile + 11
    If Worksheets("umsätze").Cells(i4, 1) = Me.txtDebnr And Worksheets("umsätze").Cells(i4, 2) = "10" Then
    Frm_Start.txt_og10.Value = Worksheets("umsätze").Cells(i4, 3)
    Frm_Start.txt_2013_OG10.Value = Worksheets("umsätze").Cells(i4, 4)
    End If
    Next
    
    End If
    Next
        
  
End Sub
to top
#5
Hi Mike,
(26.01.2015, 13:49)mikeho schrieb: Die anderen starten bei an der im ersten Lauf gefunden Stelle und machen max. 11 Durchläufe, da es nicht mehr Datensätze sein können.

Du willst also bei jeder Zeile (= 40.000) mal 10 mal 11 Durchläufe machen, statt mit Atillas Code einfach direkt den Wert zu verwenden? Oder mit meinem Code mit einer Schleife (40.000) über die Case-Funktion auch direkt den entsprechenden Wert zu nehmen?

Ok, des Menschen Wille ist sein Himmelreich.
Gruß Ralf

?mage

Die deutsche Rechtschreibung ist Freeware, d.h. du kannst sie kostenlos nutzen.
Allerdings ist sie nicht Open Source, deswegen darfst du sie nicht verändern oder in veränderter Form veröffentlichen.
to top
#6
Hallo Rabe,
nee, es wird nur einmal die 40.000 mit dem Code durchlaufen. Hierbei wird der erste Datensatz gefunden. Die weiteren Läufe starten ja bei dem gefundenen und laufen nur noch 11 Datensätze durch.
Die Performance ist mit dieser Methode tragbar. (Verzögerung unter einer Sekunde)
Mir ist schon klar das die beiden anderen Lösungsansätze wohl effektiver sind, aber ich habe erst den Code umgeschrieben und dann die beiden anderen Lösungen gesehen.
Wie gesagt, die beiden anderen Lösungen sind schon notiert und werden mit Sicherheit beim nächsten Projekt von mir berücksichtigt.
to top
#7
Hallo!
Just my two Cents:
Mit der Begründung, dass die Verzögerung "unter einer Sekunde" beträgt, wäre Apollo 11 wahrscheinlich heute noch auf dem Weg zum Mond ...
Eine Schleife mit Zellzugriffen ist so ziemlich das Langsamste, was man Excel über VBA antun kann.
Entweder man bedient sich der .Find-Methode, die einen Range liefert, dessen .Offset man auswerten kann,
oder man nutzt einen Verweis (.Match), der eine Position im Suchvektor zurückgibt, aus der man die Zeilennummer der Fundstelle ermittelt.

Beides findet zeitlich kaum messbar im Arbeitsspeicher statt.

Aber wie mein Namensvetter schon schrieb:
Rabe schrieb:Ok, des Menschen Wille ist sein Himmelreich.
Gruß Ralf
to top
#8
Hallo zusammen,

ich muss feststellen, dass mein Beispiel nicht funktionieren kann, da ich eine Bedingung übersehen habe.
Und zwar diese:
Code:
If Worksheets("umsätze").Cells(i3, 1) = Me.txtDebnr Then

Um die Performance hier entscheidend zu verbessern könnte man entweder den Spezialfilter nehmen oder mit Datenfeldern und Arrays arbeiten. Die Find Methode führt hier nicht zum Ziel.

Ich sehe aber in dem Code von Mikeho keine Verbesserung.
Aber wenn es für ihn so praktikabel ist, dann soll es so sein.

Ralfs Vorschlag ist da performanter, denke ich.
Gruß Atilla

Excel 2007
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Performance-Problem Summenprodukt Klexx 6 89 24.11.2016, 14:24
Letzter Beitrag: Klexx
  Performance Problem bea die erste 11 1.384 04.05.2015, 21:35
Letzter Beitrag: Winny

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste