Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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
Antworten 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.
Antworten 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
Antworten 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
Antworten 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.
Antworten 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.
Antworten 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
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten 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
Antworten Top


Gehe zu:


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