Suche Art Element in Array

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Klaus,
keine Ahnung ob ich Dich richtig verstanden habe. Ich bin davon ausgegangen, dass Du nach Werten aus einem 2 dimensionalem Array suchen willst und bei Übereinstimmung bestimmter Kriterien diese in ein anderes, 1-dimensionales einlesen und danach ausgeben lassen willst. Hier mal ein Bsp. dafür:
Option Explicit
Dim aOrg(5, 5) As String '2-dim. Array mit 6 x 6 Elementen


Sub suchen()
Dim aErgebnis() As String, sInhalt$, x%, y%, z%, sAusgabe$
'Array füllen
For x = 0 To 5 '1.Dimension
sInhalt = "Test" & x
For y = 0 To 5 '2.Dimension
aOrg(x, y) = sInhalt & Chr(65 + y) 'entspricht A,B,C,D,E,F
Next y
Next x
'Nach C, D und F in der 2.Dimension in allen Elementen der 1. Dimension suchen lassen
For x = 0 To UBound(aOrg())
For y = 0 To UBound(aOrg())
Select Case aOrg(x, y)
Case "Test" & x & "C", "Test" & x & "D", "Test" & x & "F"
ReDim Preserve aErgebnis(z)
aErgebnis(z) = aOrg(x, y)
z = z + 1
End Select
Next y
Next x
'Ausgabe vorbereiten
For x = 0 To UBound(aErgebnis())
sAusgabe = aErgebnis(x) & vbTab & sAusgabe
Next x
MsgBox sAusgabe
End Sub

Hoffe, ich konnte Dir helfen,
Ciao, Ralf

Hi Ralf,
vielen Dank für Deine Mühe !
Ich meinte es ein klein wenig anders.
Wenn wir noch mal das 2-dimensionale Array
Test1;a
Test2;a
Test3;b
Test4;x
Test5;x
zu Grunde legen, dann brauche ich nicht die einzelnen Elemente Test aus der 1.Dimension.
Es stehen in dem Array div. a in der zweiten Dimension - also brauche ich als Ergebnis
nur 1x das a . Gleiches gilt für alle verschiedenen Elemente der 2. Dimension.
Ich weiß vorher nicht, wie viele unterschiedliche Elemente und in welcher Anzahl sie
in der 2. Dimension vorkommen ( Die 1.Dimension ist völlig nebensächlich )
Und im Ergebnis der Suche brauche ich eine Auflistung der verschidenen Elemente der 2.Dimension ohne die Anzahl.
Kannst Du mit der Beschreibung was anfangen ?

Sub Makro() Dim Daten(1 To 5, 1 To 2) As String, tmp As Variant, Ergebnis As Variant Daten(1, 1) = "Test1" Daten(2, 1) = "Test2" Daten(3, 1) = "Test3" Daten(4, 1) = "Test4" Daten(5, 1) = "Test5" Daten(1, 2) = "x" Daten(2, 2) = "a" Daten(3, 2) = "b" Daten(4, 2) = "a" Daten(5, 2) = "x" Application.ScreenUpdating = False Worksheets.Add tmp = Application.WorksheetFunction.Index(Daten, 0, 2) [A1] = "x" Range(Cells(2, 1), Cells(2 + UBound(tmp) - LBound(tmp), 1)) = tmp Range(Cells(1, 1), Cells(2 + UBound(tmp) - LBound(tmp), 1)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True Ergebnis = Split(Join(Application.WorksheetFunction.Transpose(Range(Cells(2, 2), Cells([B2].End(xlDown).Row, 2))), ";"), ";") Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox Join(Ergebnis, ";") End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread