AW: For-Schleife nicht performant
23.11.2021 08:42:56
Florian
Ich habe es jetzt mal so versucht und in meinen Code eingebaut. Allerdings werden keine Werte gefunden und ich steige noch nicht ganz durch, wo ich suchen muss oder prüfen kann, woran es hängt.
Es sollen die Werte in den Spalten AC der Quelldatei und AC der Zieldatei verglichen werden. Dann sollen die Werte der Spalten N-S aus der Quelldatei in die Zieldatei in die entsprechende Zeile übernommen werden.
Sub DatenuebernahmeQuelldatei(strTabelleJahr As String)
Dim ialngIndex As Long
Dim wksBuchungenPruefen As Worksheet, wksQuelldatei As Worksheet
Dim strZuordnung As String
Dim lngZeilenQuelldatei As Long
Dim avntValuesBuchungenPruefen As Variant, avntValuesQuelldaten As Variant
Dim objDictionary As Object
Dim Dateiname
Dateiname = Application.GetOpenFilename(filefilter:="xlsm-Dateien (*.xlsm), *.*)", Title:="Quelldatei auswählen")
If Dateiname = "Falsch" Then
MsgBox "Keine Datei ausgewählt!"
Else
If Dateiname False Then
Application.ScreenUpdating = False
Workbooks.Open (Dateiname)
Set wksQuelldatei = ActiveWorkbook.Sheets(strTabelleJahr)
'Autofilter in Quelldaten löschen
If wksQuelldatei.FilterMode Then
wksQuelldatei.ShowAllData
End If
'Zuordnung Datenübernahme in Quelldatei schreiben
wksQuelldatei.Unprotect Password:=p_strPasswort
lngZeilenQuelldatei = wksQuelldatei.Cells(Rows.Count, 1).End(xlUp).Row
wksQuelldatei.Range("AC3:AC" & lngZeilenQuelldatei).Formula = "=A3&B3&C3&D3&E3&F3&G3&I3"
wksQuelldatei.Protect userinterfaceonly:=True, AllowFiltering:=True, Password:=p_strPasswort
End If
Application.ScreenUpdating = False
'Tabellenblatt Buchungen prüfen setzen
Set wksBuchungenPruefen = ThisWorkbook.Worksheets(strTabelleJahr)
'Autofilter in Buchungen prüfen löschen
If wksBuchungenPruefen.FilterMode Then
wksBuchungenPruefen.ShowAllData
End If
'Autofilter in Quelldaten löschen
If wksQuelldatei.FilterMode Then
wksQuelldatei.ShowAllData
End If
With wksBuchungenPruefen
avntValuesBuchungenPruefen = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 9)).Value
End With
With wksQuelldatei
avntValuesQuelldaten = .Range(.Cells(3, 14), .Cells(Rows.Count, 29).End(xlUp)).Value
End With
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
For ialngIndex = LBound(avntValuesQuelldaten) To UBound(avntValuesQuelldaten)
objDictionary.Item(Key:=avntValuesQuelldaten(ialngIndex, 16)) = avntValuesQuelldaten(ialngIndex, 1)
Next
With wksBuchungenPruefen
For ialngIndex = LBound(avntValuesBuchungenPruefen) To UBound(avntValuesBuchungenPruefen)
strZuordnung = avntValuesBuchungenPruefen(ialngIndex, 1) & avntValuesBuchungenPruefen(ialngIndex, 2) & _
avntValuesBuchungenPruefen(ialngIndex, 3) & avntValuesBuchungenPruefen(ialngIndex, 4) & _
avntValuesBuchungenPruefen(ialngIndex, 5) & avntValuesBuchungenPruefen(ialngIndex, 6) & _
avntValuesBuchungenPruefen(ialngIndex, 7) & avntValuesBuchungenPruefen(ialngIndex, 9)
If objDictionary.Exists(strZuordnung) Then .Cells(ialngIndex + 2, 14).Value = objDictionary.Item(Key:=strZuordnung)
Next
End With
wksQuelldatei.Parent.Close False
Application.ScreenUpdating = True
Set objDictionary = Nothing
Set wksBuchungenPruefen = Nothing
Set wksQuelldatei = Nothing
End If
End Sub