ich brauch mal wieder eure Hilfe, da ich keine Erfahrungen mit zweidimensionalen Arrays habe in VBA.
Ich habe eine Liste mit Werten.
Ich möchte in einem Tabellenblatt nach Wert X in Spalte A suchen und wenn ich den gefunden habe, möchte ich in ein Array folgendes schreiben:
Array(0,0) = Wert aus Liste (Pendant Spalte A)
Array(0,1) = Wert aus Tabellenblatt Spalte B
Ich habe Probleme mit dem ReDim und Schreiben. Mit eindimensionalem funktioniert es prima. aber sobald ich es zweidimensional machen möchte, geht es nicht. Was mache ich falsch ?
So funktioniert es (Auszug)
Function test(ListOld() As String) As Variant
Dim arr_ID() As Variant
Dim IsFirstTime As Boolean
Stop
IsFirstTime = True
TotalRows = ThisWorkbook.Sheets("temp").Cells(ThisWorkbook.Sheets("temp").Rows.Count, "A").End(xlUp).Row
For TR = LBound(ListOld) To UBound(ListOld)
For Index = 1 To TotalRows
'Speichere aktuellen Wert
findWhat = ThisWorkbook.Sheets("temp").Cells(Index, 1).Value
If findWhat = ListOld(TR) Then
'Beim ersten Element muss anders geschrieben werden
If IsFirstTime = True Then
ReDim Preserve arr_ID(0) 'Einen Eintrag hinzufügen
arr_ID(0) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
IsFirstTime = False
Else
length = UBound(arr_ID) 'Aktuelle Länge ermitteln
ReDim Preserve arr_ID(length + 1) 'Einen Eintrag hinzufügen
arr_ID(length + 1) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
End If
End If
Next
Next
End Function
Das folgende funktioniert aber nicht
Function test(ListOld() As String) As Variant
Dim arr_ID() As Variant
Dim IsFirstTime As Boolean
IsFirstTime = True
TotalRows = ThisWorkbook.Sheets("temp").Cells(ThisWorkbook.Sheets("temp").Rows.Count, "A").End(xlUp).Row
For TR = LBound(ListOld) To UBound(ListOld)
For Index = 1 To TotalRows
'Speichere aktuellen Wert
findWhat = ThisWorkbook.Sheets("temp").Cells(Index, 1).Value
If findWhat = ListOld(TR) Then
If IsFirstTime = True Then
ReDim Preserve arr_ID(0) 'Einen Eintrag hinzufügen
arr_ID(0, 0) = ListOld(TR)
arr_ID(0, 1) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
IsFirstTime = False
Else
length = UBound(arr_ID) 'Aktuelle Länge ermitteln
ReDim Preserve arr_ID(length + 1) 'Einen Eintrag hinzufügen
'ReDim Preserve arr_ID(length + 1, length + 1) funktioniert auch nicht
arr_ID(length + 1, 0) = ListOld(TR)
arr_ID(length + 1, 1) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
End If
End If
Next
Next
End Function