AW: Gleiche Einträge in ver. Spalten in eine Zeile sor
29.10.2007 14:32:00
harry
Hallo Markus,
so müsste es auch bei Dir gehen
Sub spalten_ordnen()
'alle Werte aus 8 Spalten in eine Hilfspalte auf Tabellenblatt2 schreiben
x2 = 1
For sp = 1 To 8
x1 = 1
While Sheets("Tabelle1").Cells(x1, sp) ""
Sheets("Tabelle2").Cells(x2, 1) = Sheets("Tabelle1").Cells(x1, sp)
x1 = x1 + 1
x2 = x2 + 1
Wend
Next
'Duplikate aus Hilfsspalte löschen
Zeile = Sheets("tabelle2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
For Zaehler = Zeile To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(Zaehler, 1)) > 1 Then
Rows(Zaehler).Delete
End If
Next
'Hilfsspalte sortieren
Sheets("tabelle2").Range("a:a").Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Einzelne Spalten übertragen und ordnen
x1 = 1
While Sheets("Tabelle2").Cells(x1, 1) ""
vergl = Sheets("Tabelle2").Cells(x1, 1)
For sp = 1 To 8
x2 = 1
While Sheets("tabelle1").Cells(x2, sp) ""
If Sheets("tabelle1").Cells(x2, sp) = vergl Then
Sheets("tabelle2").Cells(x1, sp + 1) = vergl
End If
x2 = x2 + 1
Wend
Next
x1 = x1 + 1
Wend
'Hilfsspalte löschen
Sheets("tabelle2").Range("a:a").Delete
'Das Ergebnis der Transformation steht nun auf Tabellenblatt2
'Der Ursprungszustand auf Tabellenblatt1
End Sub
Gruß
Harry