Schneller mehrere Werte in Zellen schreiben

[jb95]

Hi!

Ich bin leider nicht besonders gut im VBA-Code schreiben, deswegen ist das wohl eine sehr simple Frage:

Ich muss mehrere vorher in verschiedene Variablen geschriebene Werte (Strings, Integer, Variant) in verschiedene Zellen einer Zeile schreiben, sobald eine Bedingung erfüllt ist.
Momentan habe ich das so gelöst:

---

Code:

If k = a Then

        With Sheets("DataBase")

        .Cells(k, 2).Value = "Actual Costs"
        .Cells(k, 11).Value = psp
        .Cells(k, 12).Value = datum
        .Cells(k, 13).Value = costType
        .Cells(k, 14).Value = caID
        .Cells(k, 15).Value = caDes
        .Cells(k, 16).Value = nr
        .Cells(k, 17).Value = pos
        .Cells(k, 18).Value = description
        .Cells(k, 21).Value = credDes
        .Cells(k, 20).Value = actuals

        End With
     
End If

---

Das dauert aber ewig....was ich bisher gelesen habe, macht es ein Array wesentlich schneller... leider sind die ganzen Variablen ja von unterschiedlichen Datentypen, geht das dann trotzdem?

Vielen Dank und liebe Grüße
Josh

[BoskoBiati]

Hi,

ändert sich k?

Wie sieht der komplette Code aus?

[schauan]

Hallöchen,

ob das mit den Datentypen passt wirst Du sehen, wenn die Daten in den Zellen erscheinen.

Arrays gehen in der Regel schneller, aber könnte sein, dass es bei Dir zeilenweise angebracht wäre. Edgar hat ja schon nachgefragt - Hintergrund ist m.E. ob Du immer wieder die gleiche Zeile überschreibst oder was da im restlichen Code passiert.

Ein Grund für mangelnde Performance ist neben vielen einzelnen Zelleinträgen auch, dass bei jedem Eintrag vielleicht neu gerechnet wird. Da hilft manchmal schon die Einstellung auf manuelle Berechnung zu setzen und erst nach den Eintragungen wieder auf automatisch.

[jb95]

Vielen Dank schon mal! Ja k ändert sich.

Der gesamt Code nimmt die Infos einer Bestellung (eine Zeile) aus dem Worksheet "Actuals_Export", schaut ob die Bestellung (durch Vergleich der Informationen mit jeder Zeile der DataBase) schon in der DataBase vorhanden ist - und wenn nicht (k=a) dann schreibt er die Bestellung in die erste leere Zeile am ende der DB.

Das kann man bestimmt alles sehr viel schlauer programmieren, aber bis auf den Teil des Codes, den ich am Anfang gepostet hat, funktioniert ja alles relativ schnell...

Hier ist der gesamte relevante Code:

Code:

Code:'Worksheets zur Vereinfachung als Variablen deklarieren
Dim acws As Worksheet

Dim dbws As Worksheet

Set acws = Sheets("Actuals_Export")

Set dbws = Sheets("DataBase")



Dim l As Integer

   'l ist letzte befüllte Zeile in Actuals Export

   l = acws.Cells(Rows.Count, 1).End(xlUp).Row

'Variablen zuordnen - For-Schleife geht jede Zeile des Exports durch und speichert deren Informationen in Variablen
Dim i As Integer
For i = 2 To l

Dim costType As String
costType = acws.Cells(i, 3).Value
Dim datum As Variant
datum = acws.Cells(i, 2).Value
Dim psp As String
psp = acws.Cells(i, 1).Value
Dim caID As Long
caID = acws.Cells(i, 4).Value
Dim caDes As String
caDes = acws.Cells(i, 5).Value
Dim nr As Variant
nr = acws.Cells(i, 6).Value
Dim pos As Integer
pos = acws.Cells(i, 7).Value
Dim description As String
description = acws.Cells(i, 8).Value
Dim actuals As Variant
actuals = acws.Cells(i, 10).Value
Dim credDes As String
credDes = acws.Cells(i, 11).Value



Dim a As Integer
   a = dbws.Cells(Rows.Count, 11).End(xlUp).Row + 1

'Abgleich Actuals_Export und Database
Dim k As Integer

For k = 3 To a

   'wenn keine Übereinstimmung (k = letzter zeile + 1 ), in neuer Zeile Buchung eintragen mit Informationen aus Actual_Export:
   If k = a Then
   
       dbws.Cells(k, 2).Value = "Actual Costs"
       dbws.Cells(k, 11).Value = psp
       dbws.Cells(k, 12).Value = datum
       dbws.Cells(k, 13).Value = costType
       dbws.Cells(k, 14).Value = caID
       dbws.Cells(k, 15).Value = caDes
       dbws.Cells(k, 16).Value = nr
       dbws.Cells(k, 17).Value = pos
       dbws.Cells(k, 18).Value = description
       dbws.Cells(k, 21).Value = credDes
       dbws.Cells(k, 20).Value = actuals
       
       Exit For
   
   End If
   
   'Wenn Übereinstimmung der Werte aus Variablen und der Werte in der DB, Schleife beenden
     If dbws.Cells(k, 16).Value = nr And dbws.Cells(k, 17).Value = pos And dbws.Cells(k, 2).Value = "Actual Costs" And dbws.Cells(k, 20).Value = actuals And dbws.Cells(k, 12).Value = datum Then
             
       If dbws.Cells(k, 13).Value = costType Then
       
       Exit For
       
       'falls alles bis auf den costType übereinstimmt, liegt eine Umbuchung vor und der costType wird nach Abfrage über MsgBox ggf geändert
       Else
       Dim answer As Integer
       answer = MsgBox("Umbuchung von " & dbws.Cells(k, 13).Value & " auf " & costType & " bei Bestellung " & nr & " richtig?", vbInformation + vbYesNoCancel, "Umbuchung?")
       
           If answer = vbYes Then
           dbws.Cells(k, 13).Value = costType
           dbws.Cells(k, 13).Interior.Color = vbRed
           ElseIf answer = vbCancel Then
           MsgBox "Import abgebrochen, um Umbuchung zu validieren."
           dbws.Rows(k).Select
           Exit Sub
           Else
           End If
       
       End If
       
   End If


Next k
Next i

Vielen Dank
Josh

[BoskoBiati]

Hi,

einige Anmerkungen genereller Art:

Dim-Anweisungen gehören an den Anfang des Codes.
statt Integer sollte man Long verwenden, sonst könnte es bei Schleifeb zu Problemen kommen.
Warum Datum als Variant, da gibt es doch Date?
Zudem durchläuft Dein Code alle Zeilen in Actual Export und gleicht sie mit der DatBase ab. Ist das so gewollt?



Außerdem wäre ein Tabellenmuster nicht schlecht, damit man mal sehen kann, wie das Ganze aussieht.

[Steffl]

Hallo,

klar dauert das lang, Du durchläufst die Datebase ja sehr oft. Mal mein Versuch mit der Find-Methode. Teste es mal an einer Kopie deiner Datei. Die Anmerkungen von Edgar bezüglich der Variablen habe ich zum Teil umgesetzt.

PHP-Code:

Sub prcX()
Dim acws As Worksheet
Dim dbws As Worksheet
Dim l As Long
Dim i As Long
Dim costType As String
Dim datum As Variant
Dim psp As String
Dim caID As Long
Dim caDes As String
Dim nr As Variant
Dim pos As Integer
Dim description As String
Dim actuals As Variant
Dim credDes As String
Dim a As Long
Dim k As Integer
Dim answer As VbMsgBoxResult
Dim rngTreffer As Range
Dim strTreffer As Range

Set acws = Sheets("Actuals_Export")

Set dbws = Sheets("DataBase")
'l ist letzte befüllte Zeile in Actuals Export

l = acws.Cells(Rows.Count, 1).End(xlUp).Row

'Variablen zuordnen - For-Schleife geht jede Zeile des Exports durch und speichert deren Informationen in Variablen

For i = 2 To l

costType = acws.Cells(i, 3).Value
datum = acws.Cells(i, 2).Value
psp = acws.Cells(i, 1).Value
caID = acws.Cells(i, 4).Value
caDes = acws.Cells(i, 5).Value
nr = acws.Cells(i, 6).Value
pos = acws.Cells(i, 7).Value
description = acws.Cells(i, 8).Value
actuals = acws.Cells(i, 10).Value

credDes = acws.Cells(i, 11).Value

a = dbws.Cells(Rows.Count, 11).End(xlUp).Row + 1

'Abgleich Actuals_Export und Database

Set rngTreffer = dbws.Columns(16).Find(nr, LookIn:=xlValue, lookat:=xlWhole)

If Not rngTreffer Is Nothing Then
strTreffer = rngTreffer.Address
Do
If dbws.Cells(rngTreffer.Row, 17).Value = pos And dbws.Cells(rngTreffer.Row, 2).Value = "Actual Costs" And _
dbws.Cells(rngTreffer.Row, 20).Value = actuals And dbws.Cells(rngTreffer.Row, 12).Value = datum Then
If dbws.Cells(rngTreffer.Row, 13).Value <> costType Then
answer = MsgBox("Umbuchung von " & dbws.Cells(rngTreffer.Row, 13).Value & " auf " & costType & " bei Bestellung " & nr & " richtig?", vbInformation + vbYesNoCancel, "Umbuchung?")

If answer = vbYes Then
dbws.Cells(rngTreffer.Row, 13).Value = costType
dbws.Cells(rngTreffer.Row, 13).Interior.Color = vbRed
ElseIf answer = vbCancel Then
MsgBox "Import abgebrochen, um Umbuchung zu validieren."
dbws.Rows(rngTreffer.Row).Select
Exit Sub
End If
End If
End If
Set rngTreffer = dbws.Columns(16).FindNext(rngTreffer)
Loop While strTreffer <> rngTreffer.Address
Else
dbws.Cells(a, 2).Value = "Actual Costs"
dbws.Cells(a, 11).Value = psp
dbws.Cells(a, 12).Value = datum
dbws.Cells(a, 13).Value = costType
dbws.Cells(a, 14).Value = caID
dbws.Cells(a, 15).Value = caDes
dbws.Cells(a, 16).Value = nr
dbws.Cells(a, 17).Value = pos
dbws.Cells(a, 18).Value = description
dbws.Cells(a, 21).Value = credDes
dbws.Cells(a, 20).Value = actuals
End If


' For k = 3 To a
'
' 'wenn keine Übereinstimmung (k = letzter zeile + 1 ), in neuer Zeile Buchung eintragen mit Informationen aus Actual_Export:
' If k = a Then
'
' dbws.Cells(k, 2).Value = "Actual Costs"
' dbws.Cells(k, 11).Value = psp
' dbws.Cells(k, 12).Value = datum
' dbws.Cells(k, 13).Value = costType
' dbws.Cells(k, 14).Value = caID
' dbws.Cells(k, 15).Value = caDes
' dbws.Cells(k, 16).Value = nr
' dbws.Cells(k, 17).Value = pos
' dbws.Cells(k, 18).Value = description
' dbws.Cells(k, 21).Value = credDes
' dbws.Cells(k, 20).Value = actuals
'
' Exit For
'
' End If
'
' 'Wenn Übereinstimmung der Werte aus Variablen und der Werte in der DB, Schleife beenden
' If dbws.Cells(k, 16).Value = nr And dbws.Cells(k, 17).Value = pos And dbws.Cells(k, 2).Value = "Actual Costs" And dbws.Cells(k, 20).Value = actuals And dbws.Cells(k, 12).Value = datum Then
'
' If dbws.Cells(k, 13).Value = costType Then
'
' Exit For
'
' 'falls alles bis auf den costType übereinstimmt, liegt eine Umbuchung vor und der costType wird nach Abfrage über MsgBox ggf geändert
' Else
' answer = MsgBox("Umbuchung von " & dbws.Cells(k, 13).Value & " auf " & costType & " bei Bestellung " & nr & " richtig?", vbInformation + vbYesNoCancel, "Umbuchung?")
'
' If answer = vbYes Then
' dbws.Cells(k, 13).Value = costType
' dbws.Cells(k, 13).Interior.Color = vbRed
' ElseIf answer = vbCancel Then
' MsgBox "Import abgebrochen, um Umbuchung zu validieren."
' dbws.Rows(k).Select
' Exit Sub
' End If
'
' End If
'
' End If
'
' Next k
Next i
End Sub


[jb95]

Super!

Vielen, vielen Dank. Das Problem ist gelöst.

Mit dem Code und ein wenig Aufräumarbeit in der Database läuft jetzt wieder alles rund!