Laufzeitfehler 91

Sub DatenuebernahmeQuelldatei() Dim lngAktuelleZeile, lngZeilenBuchungen As Long Dim wksBuchungenPruefen2021, wksQuelldaten As Worksheet Dim intAktuelleZeile As Long Dim strZuordnung As String 'Tabellenblatt Buchungen prüfen setzen Set wksBuchungenPruefen2021 = ActiveWorkbook.Sheets("Buchungen prüfen 2021") Set wksQuelldaten = ActiveWorkbook.Sheets("Quelldaten") 'Autofilter in Buchungen prüfen löschen If wksBuchungenPruefen2021.FilterMode Then wksBuchungenPruefen2021.ShowAllData End If 'Autofilter in Quelldaten löschen If wksQuelldaten.FilterMode Then wksQuelldaten.ShowAllData End If 'Anzahl der Buchungen in Buchungen prüfen ermitteln lngZeilenBuchungen = wksBuchungenPruefen2021.Cells(Rows.Count, 1).End(xlUp).Row For lngAktuelleZeile = 3 To lngZeilenBuchungen With wksBuchungenPruefen2021 strZuordnung = _ .Cells(lngAktuelleZeile, 1).Value & _ .Cells(lngAktuelleZeile, 2).Value & _ .Cells(lngAktuelleZeile, 3).Value & _ .Cells(lngAktuelleZeile, 4).Value & _ .Cells(lngAktuelleZeile, 5).Value & _ .Cells(lngAktuelleZeile, 6).Value & _ .Cells(lngAktuelleZeile, 7).Value & _ .Cells(lngAktuelleZeile, 9).Value End With wksBuchungenPruefen2021.Cells(lngAktuelleZeile, 14).Value = wksQuelldaten.Columns(28).Find(What:=strZuordnung, LookIn:=xlValues).Offset(-15, 0).Value Next lngAktuelleZeile End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim objCell As Range Set objCell = wksQuelldaten.Columns(28).Find(What:=strZuordnung, LookIn:=xlValues) If Not objCell Is Nothing Then wksBuchungenPruefen2021.Cells(lngAktuelleZeile, 14).Value = objCell.Offset(-15, 0).Value

Sub DatenuebernahmeQuelldatei() Dim lngAktuelleZeile, lngZeilenBuchungen As Long Dim wksBuchungenPruefen2021 As Worksheet, wksQuelldaten As Worksheet Dim intAktuelleZeile As Long Dim strZuordnung As String Dim X As Range 'Tabellenblatt Buchungen prüfen setzen Set wksBuchungenPruefen2021 = ActiveWorkbook.Sheets("Buchungen prüfen 2021") Set wksQuelldaten = ActiveWorkbook.Sheets("Quelldaten") 'Autofilter in Buchungen prüfen löschen If wksBuchungenPruefen2021.FilterMode Then wksBuchungenPruefen2021.ShowAllData End If 'Autofilter in Quelldaten löschen If wksQuelldaten.FilterMode Then wksQuelldaten.ShowAllData End If 'Anzahl der Buchungen in Buchungen prüfen ermitteln lngZeilenBuchungen = wksBuchungenPruefen2021.Cells(Rows.Count, 1).End(xlUp).Row For lngAktuelleZeile = 3 To lngZeilenBuchungen With wksBuchungenPruefen2021 strZuordnung = _ .Cells(lngAktuelleZeile, 1).Value & _ .Cells(lngAktuelleZeile, 2).Value & _ .Cells(lngAktuelleZeile, 3).Value & _ .Cells(lngAktuelleZeile, 4).Value & _ .Cells(lngAktuelleZeile, 5).Value & _ .Cells(lngAktuelleZeile, 6).Value & _ .Cells(lngAktuelleZeile, 7).Value & _ .Cells(lngAktuelleZeile, 9).Value End With 'wksBuchungenPruefen2021.Cells(lngAktuelleZeile, 14).Value = wksQuelldaten.Columns(29).Find(What:=strZuordnung, LookIn:=xlValues).Offset(-15, 0).Value Set X = wksQuelldaten.Columns(29).Find(What:=strZuordnung, LookIn:=xlValues, Lookat:=xlWhole) If Not X Is Nothing Then wksBuchungenPruefen2021.Cells(lngAktuelleZeile, 14).Value = X.Offset(0, -15) End If Next lngAktuelleZeile End Sub

Sub AnySub() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False Makro Code Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True End Sub

Hallo Florian,
so ok?


Public Sub DatenuebernahmeQuelldatei()
Dim ialngIndex As Long
Dim wksBuchungenPruefen2021 As Worksheet, wksQuelldaten As Worksheet
Dim strZuordnung As String
Dim avntValuesBuchungenPruefen2021 As Variant, avntValuesQuelldaten As Variant
Dim objDictionary As Object
Application.ScreenUpdating = False
'Tabellenblatt Buchungen prüfen setzen
Set wksBuchungenPruefen2021 = ThisWorkbook.Worksheets("Buchungen prüfen 2021")
Set wksQuelldaten = ThisWorkbook.Worksheets("Quelldaten")
'Autofilter in Buchungen prüfen löschen
If wksBuchungenPruefen2021.FilterMode Then
wksBuchungenPruefen2021.ShowAllData
End If
'Autofilter in Quelldaten löschen
If wksQuelldaten.FilterMode Then
wksQuelldaten.ShowAllData
End If
With wksBuchungenPruefen2021
avntValuesBuchungenPruefen2021 = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 9)).Value
End With
With wksQuelldaten
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 wksBuchungenPruefen2021
For ialngIndex = LBound(avntValuesBuchungenPruefen2021) To UBound(avntValuesBuchungenPruefen2021)
strZuordnung = avntValuesBuchungenPruefen2021(ialngIndex, 1) & avntValuesBuchungenPruefen2021(ialngIndex, 2) & _
avntValuesBuchungenPruefen2021(ialngIndex, 3) & avntValuesBuchungenPruefen2021(ialngIndex, 4) & _
avntValuesBuchungenPruefen2021(ialngIndex, 5) & avntValuesBuchungenPruefen2021(ialngIndex, 6) & _
avntValuesBuchungenPruefen2021(ialngIndex, 7) & avntValuesBuchungenPruefen2021(ialngIndex, 9)
If objDictionary.Exists(strZuordnung) Then .Cells(ialngIndex + 2, 14).Value = objDictionary.Item(Key:=strZuordnung)
Next
End With
Application.ScreenUpdating = True
Set objDictionary = Nothing
Set wksBuchungenPruefen2021 = Nothing
Set wksQuelldaten = Nothing
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread