Registriert seit: 06.06.2018
Version(en): 2013
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
Registriert seit: 13.04.2014
Version(en): 365, 2019
Hi,
ändert sich k?
Wie sieht der komplette Code aus?
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 06.06.2018
Version(en): 2013
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
Registriert seit: 13.04.2014
Version(en): 365, 2019
15.08.2018, 10:27
(Dieser Beitrag wurde zuletzt bearbeitet: 15.08.2018, 10:27 von 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.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Folgende(r) 1 Nutzer sagt Danke an BoskoBiati für diesen Beitrag:1 Nutzer sagt Danke an BoskoBiati für diesen Beitrag 28
• jb95
Registriert seit: 11.04.2014
Version(en): Office 2007
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
Gruß Stefan
Win 10 / Office 2016
Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:1 Nutzer sagt Danke an Steffl für diesen Beitrag 28
• jb95
Registriert seit: 06.06.2018
Version(en): 2013
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!
|