Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Füllen eines zweidimensionalen Arrays

Forumthread: Füllen eines zweidimensionalen Arrays

Füllen eines zweidimensionalen Arrays
23.04.2021 12:42:07
NW
Hallo Leute,
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
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 12:44:57
NW
Ich muss noch ergänzen (hab ich vergessen, sorry ), dass der erste Durchlauf funktioniert - der, wo ich händisch (0,0) eingebe.
Und ich habe oben beim ReDim (0,0) vergessen zu schreiben Sorry
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 12:56:44
Rudi
Hallo,
man kann nur die letzte Dimension verändern.
Teste mal:

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(1, 0) 'Einen Eintrag hinzufügen
arr_ID(0, 0) = ListOld(TR)
arr_ID(1, 0) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
IsFirstTime = False
Else
Length = UBound(arr_ID, 2) + 1 'Aktuelle Länge ermitteln
ReDim Preserve arr_ID(1, Length)  'Einen Eintrag hinzufügen
arr_ID(0, Length) = ListOld(TR)
arr_ID(1, Length) = ThisWorkbook.Sheets("temp").Cells(Index, 2).Value
End If
End If
Next
Next
test = Application.Transpose(arr_ID)    'Array drehen
End Function
Gruß
Rudi
Anzeige
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 13:08:33
NW
Hallo Rudi,
danke für deine Hilfe.
Der erste Teil hat funktioniert, ich hab es tatsächlich einlesen können.
Nur beim Transponieren kommt der Fehler, dass das Objekt es nicht unterstützt.
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 13:16:45
Rudi
Hallo,
lad mal ein Beispiel hoch.
Gruß
Rudi
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 13:24:29
NW
hhmm, schwierig. Wenn man die Spalte einfach ersetzen kann zu einem anderen array ?
Weiß nicht, ob das so funktioniert

Function test(ListOld() As String) As Variant
Dim arr_ID() As Variant
Dim IsFirstTime As Boolean
IsFirstTime = True
ListOld = ("a", "b", "c")
arr_spaltea = ("d", "e", "a", "b")
arr_spalteb = ("123", "123", "123")
TotalRows = UBound(arr_spaltea)
For TR = LBound(ListOld) To UBound(ListOld)
For Index = 1 To TotalRows
'Speichere aktuellen Wert
findWhat = arr_spaltea(Index)
If findWhat = ListOld(TR) Then
If IsFirstTime = True Then
ReDim Preserve arr_ID(1, 0) 'Einen Eintrag hinzufügen
arr_ID(0, 0) = ListOld(TR)
arr_ID(1, 0) = arrspalteb(Index)
IsFirstTime = False
Else
Length = UBound(arr_ID, 2) + 1 'Aktuelle Länge ermitteln
ReDim Preserve arr_ID(1, Length)  'Einen Eintrag hinzufügen
arr_ID(0, Length) = ListOld(TR)
arr_ID(1, Length) = arrspalteb(Index)
End If
End If
Next
Next
test = Application.Transpose(arr_ID)    'Array drehen
End Function

Anzeige
AW: Füllen eines zweidimensionalen Arrays
23.04.2021 13:54:20
NW
Ich denke ich habe es gelöst.
Mit dem Transponse funktioniert es leider nicht, hatte ich schonmal das Problem, aber mit einer Schleife, die vorher über ReDim die Dimensionen vertauscht, klappt es super

Sub test()
Dim temp() As Variant
ReDim temp(LBound(arr_ID, 2) To UBound(arr_ID, 2), LBound(arr_ID, 1) To UBound(arr_ID, 1))
For i = LBound(arr_ID, 2) To UBound(arr_ID, 2)
temp(i, 0) = arr_ID(0, i)
temp(i, 1) = arr_ID(1, i)
Next
End Sub
Danke für Deine Hilfe Rudi zwecks dem Einlesen :-)
Anzeige
XL365: mit .Formula2 sehr kurz (Variant-Array)
25.04.2021 07:19:53
lupo1
XL365:
1) Deine Daten stehen in A:B, und
2) Die Sätze für A="x" sollen in H:I ausgegeben werden:
2 Alternativen
Sub PhysischesArrayGefiltertInVariantArray()
[E1].Formula2 = "=FILTER(A:B,A:A=""X"")"
VArr = [E1:F999]
[E:F].Clear
[H1:I999] = VArr
End Sub
oder
a) ohne Zwischen-Range E:F im Blatt
b) und ohne Fix-Dimensionierung:
Sub PhysischesArrayGefiltertInVariantArray()
VArr = Evaluate("=FILTER(A:B,A:A=""X"")")
[H1].Resize(UBound(VArr, 1), 2) = VArr
End Sub
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige