AW: Bereich m. unbekannten sortieren(Spalte)
26.02.2022 16:51:25
Daniel
Hi
du könntest diesen Code drüberlaufen lassen.
Public Sub sortierung()
Dim arr
Dim erg
Dim dicFische As Object
Dim z As Long, s As Long
Dim ZählerFische As Long
ZählerFische = 3
arr = Range("D1").CurrentRegion.Value
Set dicFische = CreateObject("Scripting.dictionary")
ReDim erg(1 To UBound(arr, 1), 1 To 3)
erg(1, 1) = arr(1, 1)
erg(1, 2) = arr(1, 2)
erg(1, 3) = arr(1, UBound(arr, 2))
For z = 2 To UBound(arr, 1)
erg(z, 1) = arr(z, 1)
erg(z, 2) = arr(z, 2)
erg(z, 3) = arr(z, UBound(arr, 2))
For s = 3 To UBound(arr, 2) - 1
If arr(z, s) "" Then
If Not dicFische.exists(arr(z, s)) Then
dicFische(arr(z, s)) = dicFische.Count
ReDim Preserve erg(1 To UBound(erg, 1), 1 To dicFische(arr(z, s)) + 4)
erg(1, dicFische(arr(z, s)) + 4) = arr(z, s)
End If
erg(z, dicFische(arr(z, s)) + 4) = arr(z, s)
End If
Next
Next
With Range("D1").Resize(UBound(erg, 1), UBound(erg, 2))
.Value = erg
.Cells(1, 3).Value = True
.Offset(0, 2).Resize(, .Columns.Count - 2).Sort key1:=.Cells(1, 3), order1:=xlAscending, Header:=xlNo, Orientation:=2
.Cells(1, UBound(erg, 2)) = arr(1, UBound(arr, 2))
End With
achtung, der Code überschreibt die Ausgangsdaten, zum testen hier mal beim unteren With Range("D1") vielleicht einen anderen Zellbereich eintragen.
außerdem sortiert der Code auch, aber nicht Zeilen, sondern Spalten, damit die Fische auch leichter zu finden sind und das Ergebnis auch am Schluss steht (wird sonst aufwendiger bei unbekannter Fischanzahl). Da sich Excel diese Einstellung merkt, solltest du hinterher nochwas nach Zeilen sortieren (Orientation = 2), weil das die übliche Einstellung ist, von der man normalerweise ausgeht.
Und hier nochmal eine andere Methode für menschen, die mit VBA nur Grundkenntnisse haben:
1. kopiere dir folgenden Code in ein allgemeines Modul:
Function FischListe(Zellen As Range, Pos As Long) As String
Dim T
Dim txt As String
txt = "|"
For Each T In Zellen.Value
If T "" Then If InStr(txt, "|" & T & "|") = 0 Then txt = txt & T & "|"
Next
T = Split(txt, "|")
If Pos
2. in die Zelle K1 (überschrift) kommt diese Formel, die du nach rechts ziehst bis keine Fische mehr angezeigt werden
=fischliste($F$2:$H$6;SPALTE(A1))
3. in die Zelle K2 kommt diese Formel, die du nach rechts und nach unten ziehst:
=WENN(ZÄHLENWENN($F2:$H2;J$1);J$1;"")
Gruß Daniel