Hallo Leute,
ich komm nicht mehr weiter.
Irgendwie wird das Array nicht richtig Tranponiert
Es gibt immer den Fehler außerhalb des gültigen Bereichs ab Sheets(2).Range("A" & i + 1) = arr4(i, 1)
Wär super wenn mir jmd. sagen kann was da schief läuft.
hier der Code:
Option Explicit
<pre>Sub Vergleich()
'
Dim loletzte As Integer
Dim arr1, arr As Variant
Dim arr3(), arr4()
Dim z, d, i, j As Integer
Sheets(2).UsedRange.Clear
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
loletzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
arr = Range("A3:D" & loletzte)
loletzte = IIf(IsEmpty(Cells(Rows.Count, 8)), Cells(Rows.Count, 8).End(xlUp).Row, Rows.Count)
arr1 = Range("F3:I" & loletzte)
z = 1
For i = LBound(arr) To UBound(arr) Step 1
For d = LBound(arr1) To UBound(arr1) Step 1
If arr(i, 3) = arr1(d, 3) Then
GoTo ende
ElseIf d = UBound(arr1) Then
ReDim Preserve arr3(1 To 4, 1 To z)
arr3(2, z) = arr(i, 2)
arr3(1, z) = arr(i, 1)
arr3(3, z) = arr(i, 3)
arr3(4, z) = arr(i, 4)
z = z + 1
End If
Next
ende:
Next
If z = 1 Then
MsgBox ("Keinen Fehler an der Adresse gefunden")
GoTo endee
Else
MsgBox ("Fehler gefunden! Bitte Seite 2 überprüfen")
arr4 = WorksheetFunction.Transpose(arr3)
Sheets(2).Range("A2:A" & UBound(arr3) + 2).NumberFormat = "@"
Sheets(2).Range("B2:B" & UBound(arr3) + 2).NumberFormat = "@"
Sheets(2).Range("C2:C" & UBound(arr3) + 2).NumberFormat = "@"
Sheets(2).Range("D2:D" & UBound(arr3) + 2).NumberFormat = "@"
For i = LBound(arr3) To UBound(arr3) Step 1
Sheets(2).Range("A" & i + 1) = arr4(i, 1)
Sheets(2).Range("B" & i + 1) = arr4(i, 2)
Sheets(2).Range("C" & i + 1) = arr4(i, 3)
Sheets(2).Range("D" & i + 1) = arr4(i, 4)
Next
End If
endee:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End <pre>Sub