VBA - Array-Werte einsortieren | HERBERS Excel Forum

Sub Array_Reihenfolge() Dim vntQuell(2), vntZiel vntQuell(0) = Array("cn", "h3", "e2", "lo", "te", "no", "cc") vntQuell(1) = Array("cn", "dn", "h3", "e2", "lo", "no") vntQuell(2) = Array("aa", "dn", "h3", "bb", "e2", "lo", "no", "f1") ' gesuchtes Ergebnis: ' vntZiel = Array("cn", "aa", "dn", "h3", "bb", "e2", "lo", "te", "no", "cc", f1") End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Christian
Könnte das hier eine Lösung für dich sein?

Sub Array_Reihenfolge()
Dim vntQuell(2), vntZiel, liIdx As Integer, liIdx2 As Integer, lloRow As Long
vntQuell(0) = Array("cn", "h3", "e2", "lo", "te", "no", "cc")
vntQuell(1) = Array("cn", "dn", "h3", "e2", "lo", "no")
vntQuell(2) = Array("aa", "dn", "h3", "bb", "e2", "lo", "no", "f1")
lloRow = 1
ActiveSheet.Cells.Clear
For liIdx = 0 To 2
For liIdx2 = 0 To UBound(vntQuell(liIdx), 1)
Range("A" & lloRow).Value = vntQuell(liIdx)(liIdx2)
lloRow = lloRow + 1
Next
Next
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:A21")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With ActiveSheet
For lloRow = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If .Cells(lloRow, 1).Value = .Cells(lloRow - 1, 1).Value Then
.Rows(lloRow).Delete
End If
Next
vntZiel = Array(.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value)
End With
End Sub

Mein Code löscht zuerst alle Zellen in der Hilfstabelle, die nötig ist, da ich die Sortierfunktion von Excel nutze.
Dann werden im 2. Schritt alle Werte aus der Array-Variablen vntQuell in die Tabelle in Spalte A geschrieben.
Danach wird Spalte A mit Excel-Sortier-Funktion sortiert.
Im nächsten Schritt wird in einer For/Next-Schleife Spalte A nach doppelten Einträgen durchsucht.
Wenn gefunden, werden die Zeilen mit den doppelten Einträgen gelöscht.
Im letzten Schritt wird nun der Variablen vntZiel der übrig gebliebene Inhalt aus Spalte A mit Hilfe der Array-Funktion übergeben.
Ok, nun sind die Inhalte in der Zielvariablen vntZiel sortiert; das war nicht deine Vorgabe.
Aber vielleicht hilft es ja trotzdem.
Tut es das denn?
Ciao
Thorsten

Sub Array_Versuch() Dim vntQuell(2) As Variant Dim vntZiel As Variant Dim liIdx As Integer Dim liIdx2 As Integer Dim lloRow As Long Dim lloInsert As Long Dim bGefunden As Boolean vntQuell(0) = Array("cn", "h3", "e2", "lo", "te", "no", "cc") vntQuell(1) = Array("cn", "dn", "h3", "e2", "lo", "no") vntQuell(2) = Array("aa", "dn", "h3", "bb", "e2", "lo", "no", "f1") lloRow = 1 With ThisWorkbook.Worksheets("Tabelle2") ' den Tabellenblattnamen ggf. anpassen! .Range("A1:A25").ClearContents ' den Hilfsbereich leeren/löschen ' den ersten Array in den Hilfsbereich (Spalte A) kopieren For liIdx = 0 To UBound(vntQuell(0)) .Range("A" & lloRow).Value = vntQuell(0)(liIdx) lloRow = lloRow + 1 Next liIdx ' die weiteren Arrays non hinten abarbeiten For liIdx = 1 To 2 ' die Anzahl 2 ggf. auf die vorhandenen Array anpassen lloInsert = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 For liIdx2 = UBound(vntQuell(liIdx), 1) To 0 Step -1 For lloRow = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row If vntQuell(liIdx)(liIdx2) = .Range("A" & lloRow).Value Then bGefunden = True Exit For End If Next lloRow If bGefunden Then bGefunden = False lloInsert = lloRow Else .Range("A" & lloInsert).Insert Shift:=xlDown .Range("A" & lloInsert).Value = vntQuell(liIdx)(liIdx2) End If Next liIdx2 Next liIdx vntZiel = Array(.Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value) End With End Sub

Sub Array_Reihenfolge() Dim arL As Long, ix As Long, vntQuell(2), vQ, vntZiel vntQuell(0) = Array("cn", "h3", "e2", "lo", "te", "no", "cc") vntQuell(1) = Array("cn", "dn", "h3", "e2", "lo", "no") vntQuell(2) = Array("aa", "dn", "h3", "bb", "e2", "lo", "no", "f1") With WorksheetFunction arL = .Max(UBound(vntQuell(0)), UBound(vntQuell(1)), UBound(vntQuell(2))) For Each vQ In vntQuell If UBound(vQ) VJoin(.Transpose(.Transpose(vntQuell)), , cxRTrue)) End With ActiveWindow.RangeSelection.Resize(1, UBound(vntZiel) + 1) = vntZiel Rem Das gesuchte Ergebnis ist so falsch: ' vntZiel = Array("cn", "aa", "dn", "h3", "bb", "e2", "lo", "te", "no", "cc", "f1") ' Entweder Array("cn", "aa", "h3", "dn", "e2", "lo", "bb", "te", "no", "cc", "f1") ' oder Array("cn", "h3", "e2", "lo", "te", "no", "cc", "dn", "aa", "bb", "f1") ' m.nur 1× .Transpose; sonst unlogisch, da weder zeilen- noch spaltenwss Vorgehen! End Sub

Beliebteste Forumthreads (12 Monate)

VBA - Array-Werte einsortieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - Array-Werte einsortieren

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

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread