Zeilen slicen in loop 2D Array
05.03.2018 21:10:51
Anton2
mit dem Skript (s.u.) möchte ich mit einem Loop den Inhalt von arr(i,j) erste Zeile erste Spalte mit arr(i+1,j) zweite Zeile erste Spalte, vergleichen. Wenn arr(1,1) also mit arr(2,1) übereinstimmt, soll die komplette Zeile in wksWrite - beginnend bei A1 - fortlaufend eingefügt werden. Oder erstmal sammeln und dann kopieren.
Irgendwie macht das Skript nicht was es soll. Ich komm einfach nicht drauf. Danke für eure Hilfe!
Sub Pfade()
Dim arr As Variant
Dim wksWrite As Worksheet
Dim wksRead As Worksheet
Dim maxCell As Long
Dim maxCol As Long
Dim i As Long
Dim j As Long
Dim row As Variant
Set wksWrite = ThisWorkbook.Worksheets("Tabelle1")
Set wksRead = ThisWorkbook.Worksheets("Dataset1")
With wksRead
maxCell = .Cells(.Rows.Count, 1).End(xlUp).row
maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
arr = .Range(.Cells(1, 1).Address, .Cells(maxCell, maxCol).Address)
End With
For i = 1 To UBound(arr, 1)
For j = 1 To 1
If arr(i, j) = arr(i + 1, j) Then
row = Application.WorksheetFunction.Index(arr, i, 0)
wksWrite.Range("A" & i) = row
End If
Next j
Next i
End Sub