ich habe folgenden Code in Verwendung wenn ich jedoch das zweite mal ausführe funktionierte es nicht mehr.(Beim ersten mal wunderbar)
Folgende Zeile des Codes bringt beim zweiten durchlauf den fehler:
ArTab1 = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp).Offset(0, 4))
Mein code
Sub Versuch()
' 1 2 3 4
'MNr....VAC....Anr....VNr....Z Tabelle1
'VAC....VNr....Z TAbelle2
Dim dicVNR1 As New Dictionary
Dim dicZ As New Dictionary
Dim ArTab1 As Variant
Dim i As Long
Dim t
t = Timer
'Tabelle1 in ein Array
With Worksheets("Tabelle1")
ArTab1 = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp).Offset(0, 4))
End With
Debug.Print "Eintragen Array: " & Timer - t
'Tabelle 2 in Dictionarys
With Worksheets("Tabelle2")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
dicVNR1.Add .Cells(i, 1).Value, .Cells(i, 2).Value
dicZ.Add .Cells(i, 1).Value, .Cells(i, 3).Value
Next
End With
Debug.Print "dictionarys: " & Timer - t
'"Sverweis":
For i = 1 To UBound(ArTab1, 1)
ArTab1(i, 3) = dicVNR1.Item(ArTab1(i, 1))
ArTab1(i, 4) = dicZ.Item(ArTab1(i, 1))
Next
Debug.Print """Sverweis"" in Array: " & Timer - t
'in Tabelle eintragen
With Worksheets("Tabelle1")
Application.ScreenUpdating = False
.Range(.Cells(1, 2), Cells(UBound(ArTab1, 1), 5)).Value = ArTab1
Application.ScreenUpdating = True
End With
Erase ArTab1
Debug.Print "Eintragen: " & Timer - t
End Sub
Vielen Dank für Eure Hilfe