Hallo ...
... die Lösung die ich anbieten kann ist auf die Schnelle leider nicht
sehr elegant, aber sie funktioniert.
Das vba-Makro sieht dazu so aus (die Zeilen sind praktisch
selbsterklärend:
---------------------- SCHNIPP --------------------8<--------------
Sub TwinSort()
'
' Sortiert die Werte von 2 nebeneinander liegenden Spalten
' in aufsteigender Folge (Zick-Zack)
'
' Makro von Peter Balss - 06.12.2011
'
Dim AnzZeilen As Integer
Dim i As Integer
Dim WertLinks
Dim WertRechts
Dim WertRechtsOben
Dim ErsteZelle
WertLinks = 0
WertRechts = 0
WertRechtsOben = 0
ErsteZelle = "A1" ' Liste beginnt hier auf Zelle "A1"
Range(ErsteZelle).Select
Range(Selection, Selection.End(xlDown)).Select
AnzZeilen = Selection.Rows.Count
For i = 1 To AnzZeilen
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Cells(1, 1), Order1:=xlAscending, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Cells(1, 2), Order1:=xlAscending, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range(Cells(i, 1), Cells(i, 2)).Font.Bold = True
WertLinks = Cells(i, 1).Value
WertRechts = Cells(i, 2).Value
If WertLinks > WertRechts Then
Cells(i, 1).Value = WertRechts
Cells(i, 2).Value = WertLinks
End If
If i > 1 Then
WertRechtsOben = Cells(i - 1, 2).Value
If WertRechtsOben > WertLinks Then
Debug.Print WertLinks
Debug.Print WertRechtsOben
Cells(i - 1, 2).Value = WertLinks
Cells(i, 1).Value = WertRechtsOben
End If
End If
Range(ErsteZelle).Select
Selection(i, 1).Select
Next i
End Sub
---------------------- SCHNAPP -------------------->8--------------
