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!