VBA verkürzen / beschleunigen?

[Thomas78]

Hallo mal wieder in die liebe Forenrunde,

heute hätte ich mal eine Frage bzgl. eines funktionieren VBA Codes. Mit unten stehen Code übertrage ich Kunden- / Lieferantenrechnungen in eine Umsatzliste. Mittlerweile haben sich ca. 2000 Zeilen Umsätze angesammelt.
Beim Klick auf "Speichern" in meiner Userform dauert es immer ein paar Sekunden bis die jeweiligen Daten übertragen werden.

Liegt dies an der Menge der Umsätze oder kann ich folgenden Code verkürzen / beschleunigen?

Code:

Private Sub Speichern_Click()

   Dim lngErste As Long
   With Sheets("Umsätze")
   ' letzte freie Zeile in Spalte B finden
   lngErste = Application.CountA(.Columns(2)) + 3
   ' jeweils prüfen ob Artikel ausgefüllt dann Übertrag
   If ComboBox2.Value <> "" Then
       .Range("B" & lngErste).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste).Value = CDate(Me.TextBox23.Value)
       .Range("D" & lngErste).Value = ComboBox1.Value
       .Range("E" & lngErste).Value = TextBox1.Value
       .Range("F" & lngErste).Value = ComboBox2.Value
       .Range("G" & lngErste).Value = CDbl(TextBox2)
   End If
       If TextBox12.Value <> "" Then
       .Range("H" & lngErste).Value = CCur(TextBox12)
   End If
   
   If ComboBox3.Value <> "" Then
       .Range("B" & lngErste + 1).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 1).Value = CDate(Me.TextBox24.Value)
       .Range("D" & lngErste + 1).Value = ComboBox1.Value
       .Range("E" & lngErste + 1).Value = TextBox1.Value
       .Range("F" & lngErste + 1).Value = ComboBox3.Value
       .Range("G" & lngErste + 1).Value = CDbl(TextBox3)
   End If
       If TextBox13.Value <> "" Then
       .Range("H" & lngErste + 1).Value = CCur(TextBox13)
   End If
   
   If ComboBox4.Value <> "" Then
       .Range("B" & lngErste + 2).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 2).Value = CDate(Me.TextBox25.Value)
       .Range("D" & lngErste + 2).Value = ComboBox1.Value
       .Range("E" & lngErste + 2).Value = TextBox1.Value
       .Range("F" & lngErste + 2).Value = ComboBox4.Value
       .Range("G" & lngErste + 2).Value = CDbl(TextBox4)
   End If
       If TextBox14.Value <> "" Then
       .Range("H" & lngErste + 2).Value = CCur(TextBox14)
   End If
   
   If ComboBox5.Value <> "" Then
       .Range("B" & lngErste + 3).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 3).Value = CDate(Me.TextBox26.Value)
       .Range("D" & lngErste + 3).Value = ComboBox1.Value
       .Range("E" & lngErste + 3).Value = TextBox1.Value
       .Range("F" & lngErste + 3).Value = ComboBox5.Value
       .Range("G" & lngErste + 3).Value = CDbl(TextBox5)
   End If
       If TextBox15.Value <> "" Then
       .Range("H" & lngErste + 3).Value = CCur(TextBox15)
   End If
   
   If ComboBox6.Value <> "" Then
       .Range("B" & lngErste + 4).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 4).Value = CDate(Me.TextBox27.Value)
       .Range("D" & lngErste + 4).Value = ComboBox1.Value
       .Range("E" & lngErste + 4).Value = TextBox1.Value
       .Range("F" & lngErste + 4).Value = ComboBox6.Value
       .Range("G" & lngErste + 4).Value = CDbl(TextBox6)
   End If
       If TextBox16.Value <> "" Then
       .Range("H" & lngErste + 4).Value = CCur(TextBox16)
   End If
   
   If ComboBox7.Value <> "" Then
       .Range("B" & lngErste + 5).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 5).Value = CDate(Me.TextBox28.Value)
       .Range("D" & lngErste + 5).Value = ComboBox1.Value
       .Range("E" & lngErste + 5).Value = TextBox1.Value
       .Range("F" & lngErste + 5).Value = ComboBox7.Value
       .Range("G" & lngErste + 5).Value = CDbl(TextBox7)
   End If
       If TextBox17.Value <> "" Then
       .Range("H" & lngErste + 5).Value = CCur(TextBox17)
   End If
   
   If ComboBox8.Value <> "" Then
       .Range("B" & lngErste + 6).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 6).Value = CDate(Me.TextBox29.Value)
       .Range("D" & lngErste + 6).Value = ComboBox1.Value
       .Range("E" & lngErste + 6).Value = TextBox1.Value
       .Range("F" & lngErste + 6).Value = ComboBox8.Value
       .Range("G" & lngErste + 6).Value = CDbl(TextBox8)
   End If
       If TextBox18.Value <> "" Then
       .Range("H" & lngErste + 6).Value = CCur(TextBox18)
   End If
   
   If ComboBox9.Value <> "" Then
       .Range("B" & lngErste + 7).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 7).Value = CDate(Me.TextBox30.Value)
       .Range("D" & lngErste + 7).Value = ComboBox1.Value
       .Range("E" & lngErste + 7).Value = TextBox1.Value
       .Range("F" & lngErste + 7).Value = ComboBox9.Value
       .Range("G" & lngErste + 7).Value = CDbl(TextBox9)
   End If
       If TextBox19.Value <> "" Then
       .Range("H" & lngErste + 7).Value = CCur(TextBox19)
   End If
   
   If ComboBox10.Value <> "" Then
       .Range("B" & lngErste + 8).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 8).Value = CDate(Me.TextBox31.Value)
       .Range("D" & lngErste + 8).Value = ComboBox1.Value
       .Range("E" & lngErste + 8).Value = TextBox1.Value
       .Range("F" & lngErste + 8).Value = ComboBox10.Value
       .Range("G" & lngErste + 8).Value = CDbl(TextBox10)
   End If
       If TextBox20.Value <> "" Then
       .Range("H" & lngErste + 8).Value = CCur(TextBox20)
   End If
   
   If ComboBox11.Value <> "" Then
       .Range("B" & lngErste + 9).Value = CDate(Me.TextBox22.Value)
       .Range("C" & lngErste + 9).Value = CDate(Me.TextBox32.Value)
       .Range("D" & lngErste + 9).Value = ComboBox1.Value
       .Range("E" & lngErste + 9).Value = TextBox1.Value
       .Range("F" & lngErste + 9).Value = ComboBox11.Value
       .Range("G" & lngErste + 9).Value = CDbl(TextBox11)
   End If
       If TextBox21.Value <> "" Then
       .Range("H" & lngErste + 9).Value = CCur(TextBox21)
   End If
   
   End With
     
       Unload Me 'Userform leeren
       UserForm1.Show 'Userform neu starten
       'Tabelle Umsätze sortieren?
       
   
   End Sub

Vielen Dank für eure Hilfe!

Schöne Grüße 

Thomas

[Steffl]

Hallo Thomas,

mal ungetestet

Code:

Private Sub Speichern_Click()
    Dim lngC As Long
    Dim lngErste As Long
    With Sheets("Umsätze")
    ' letzte freie Zeile in Spalte B finden
    lngErste = Application.CountA(.Columns(2)) + 3
    ' jeweils prüfen ob Artikel ausgefüllt dann Übertrag
    For lngC = 2 To 11
    
    If Controls("ComboBox" & lngC).Value <> "" Then
        .Range("B" & lngErste - 2 + lngC).Value = CDate(Me.TextBox22.Value)
        .Range("C" & lngErste - 2 + lngC).Value = CDate(Controls("TextBox" & lngC + 21).Value)
        .Range("D" & lngErste - 2 + lngC).Value = ComboBox1.Value
        .Range("E" & lngErste - 2 + lngC).Value = TextBox1.Value
        .Range("F" & lngErste - 2 + lngC).Value = Controls("ComboBox" & lngC).Value
        .Range("G" & lngErste - 2 + lngC).Value = CDbl(Controls("TextBox" & lngC))
    End If
    If Controls("TextBox" & lngC + 10).Value <> "" Then
        .Range("H" & lngErste - 2 + lngC).Value = CCur(Controls("TextBox" & lngC + 10))
    End If
    
    Next lng
    
    End With
      
        Unload Me 'Userform leeren
        UserForm1.Show 'Userform neu starten
        'Tabelle Umsätze sortieren?
        
    
End Sub

[Thomas78]

Hallo Stefan,

vielen Dank für deine schnelle Rückmeldung !

Dein Code ist schön kurz und funktioniert bei den ersten Tests einwandfrei. (Ich musste nur Next lng mit Next lngc ersetzen).

Leider ist er aber auch nicht schneller als mein bisheriger Code. Liegts doch an der Menge der Zeilen?

Schöne Grüße Thomas

[Steffl]

Hallo Thomas,

an der Zahl der Zellzugriffe. Eventuell hast Du auch noch im Tabellenblatt Ereignisse oder das Tabellenblatt wird neu berechnet oder....

[Thomas78]

Hallo Stefan,

ja es gibt noch die Bestandstabelle die auf die Umsatzliste zugreift und den Bestand, EK-Preis, usw. darstellt. Vermutlich liegts dann an diesen Abfragen (ca. 500 Artikel die ständig die Umsatzliste überwachen und eben Bestand und Preis berechnen).

Trotzdem vielen Dank für deine Hilfe !!!

Schöne Grüße
Thomas

[Der Steuerfuzzi]

Hallo,

probier das mal bitte:

Code:

Private Sub Speichern_Click2()
    Dim lngC As Long
    Dim lngErste As Long
    With Sheets("Umsätze")
        ' letzte freie Zeile in Spalte B finden
        lngErste = Application.CountA(.Columns(2)) + 3
        ' jeweils prüfen ob Artikel ausgefüllt dann Übertrag
        Dim Werte As Variant
        Werte = .Range("B2:H11").Value
        For lngC = 2 To 11
            If controls("ComboBox" & lngC).Value <> "" Then
                Werte(lngErste - 2 + lngC, 1) = CDate(Me.TextBox22.Value)
                Werte(lngErste - 2 + lngC, 2) = CDate(controls("TextBox" & lngC + 21).Value)
                Werte(lngErste - 2 + lngC, 3) = ComboBox1.Value
                Werte(lngErste - 2 + lngC, 4) = TextBox1.Value
                Werte(lngErste - 2 + lngC, 5) = controls("ComboBox" & lngC).Value
                Werte(lngErste - 2 + lngC, 6) = CDbl(controls("TextBox" & lngC))
            End If
            If controls("TextBox" & lngC + 10).Value <> "" Then
                Werte(lngErste - 2 + lngC, 7) = CCur(controls("TextBox" & lngC + 10))
            End If
        Next lngC
        .Range("B2:H11").Value = Werte
    End With
      
        Unload Me 'Userform leeren
        UserForm1.Show 'Userform neu starten
        'Tabelle Umsätze sortieren?
        
    
End Sub

[Thomas78]

Hallo Michael,

auch dir danke!

Bei deinem Code markiert er mir 

PHP-Code:

Werte(lngErste - 2 + lngC, 1) = CDate(Me.TextBox22.Value) 


mit "Laufzeitfehler 9 : Index ausserhalb des gültigen Bereichs"
Schöne Grüße
Thomas

[Der Steuerfuzzi]

Entschuldige bitte, da habe ich einen Fehler eingebaut :@
Ich hoffe, so passt es:

Code:

Private Sub Speichern_Click2()
    Dim lngC As Long
    Dim lngErste As Long
    With Sheets("Umsätze")
        ' letzte freie Zeile in Spalte B finden
        lngErste = Application.CountA(.Columns(2)) + 3
        ' jeweils prüfen ob Artikel ausgefüllt dann Übertrag
        Dim Werte As Variant
        Werte = .Range("B" & lngErste & ":H" & lngErste + 9).Value
        For lngC = 1 To 10
            If controls("ComboBox" & lngC).Value <> "" Then
                Werte(lngC, 1) = CDate(Me.TextBox22.Value)
                Werte(lngC, 2) = CDate(controls("TextBox" & lngC + 21).Value)
                Werte(lngC, 3) = ComboBox1.Value
                Werte(lngC, 4) = TextBox1.Value
                Werte(lngC, 5) = controls("ComboBox" & lngC).Value
                Werte(lngC, 6) = CDbl(controls("TextBox" & lngC))
            End If
            If controls("TextBox" & lngC + 10).Value <> "" Then
                Werte(, 7) = CCur(controls("TextBox" & lngC + 10))
            End If
        Next lngC
        .Range("B" & lngErste & ":H" & lngErste + 9).Value
    End With
      
        Unload Me 'Userform leeren
        UserForm1.Show 'Userform neu starten
        'Tabelle Umsätze sortieren?
        
    
End Sub

[Thomas78]

Hallo Michael,

vielen Dank aber klappt leider auch nicht.

"Fehler beim Kompilieren : Syntaxfehler"

er springt zu 

Werte(, 7) 

habs auch mit Werte(lngC,7) probiert aber hat nichts gebracht.

Hast du noch eine Idee?

Schöne Grüße

Thomas

[Der Steuerfuzzi]

Tut mir leid, da habe ich wieder in der Eile nicht aufgepasst und gleich 2 blöde Fehler gemacht :@ . Ich versuche es nochmal:

Code:

Private Sub Speichern_Click2()
    Dim lngC As Long
    Dim lngErste As Long
    With Sheets("Umsätze")
        ' letzte freie Zeile in Spalte B finden
        lngErste = Application.CountA(.Columns(2)) + 3
        ' jeweils prüfen ob Artikel ausgefüllt dann Übertrag
        Dim Werte As Variant
        Werte = .Range("B" & lngErste & ":H" & lngErste + 9).Value
        For lngC = 2 To 11
            If Controls("ComboBox" & lngC).Value <> "" Then
                Werte(lngC - 1, 1) = CDate(Me.TextBox22.Value)
                Werte(lngC - 1, 2) = CDate(Controls("TextBox" & lngC + 21).Value)
                Werte(lngC - 1, 3) = ComboBox1.Value
                Werte(lngC - 1, 4) = TextBox1.Value
                Werte(lngC - 1, 5) = Controls("ComboBox" & lngC).Value
                Werte(lngC - 1, 6) = CDbl(Controls("TextBox" & lngC))
            End If
            If Controls("TextBox" & lngC + 10).Value <> "" Then
                Werte(lngC - 1, 7) = CCur(Controls("TextBox" & lngC + 10))
            End If
        Next lngC
        .Range("B" & lngErste & ":H" & lngErste + 9).Value
    End With
      
        Unload Me 'Userform leeren
        UserForm1.Show 'Userform neu starten
        'Tabelle Umsätze sortieren?
        
    
End Sub