AW: XY Koordinaten in Spalten und Zeilennr. umwand
09.12.2007 07:00:00
fcs
Hallo Thomas,
wenn die Funktion RANG (diese wertet Zahlen wie Sportergebnisse aus, dass heißt bei gleichen Zahlen werden nachfolgende Ränge nicht vergeben) nicht ausreicht, dann muss man folgende Schritte machen, um zum Ergebnis zukommen. Mir ist jedenfalls keine direkte Formellösung bekannt.
1. in einer Hilfsspalte (E) die Reihenfolge der aktuellen Sortierung merken, falls erforderlich
(Zahlenfolge 1, 2, 3 usw. in die Zeilen eintragen per Zellen-Zehfunktion)
2. Alle Zeilen nach den X-Werten (Spalte A) sortieren
3. In Zeile 1 den Rang 1 in einer Spalte (C) eintragen
4. Dannach in Zeile 2 der Spalte folgende Formel eingeben und für alle Zeilen nach unten kopieren
=WENN(A2=A1;C1;C1+1)
5. in der Spalte die Formeln durch die Werte ersetzen (Spalte markieren, kopieren, Inhalte einfügen...(Werte)
6. Alle Zeilen nach den Y-Werten (Spalte B) sortieren
7. In Zeile 1 den Rang 1 in einer Spalte (D) eintragen
8. Dannach in Zeile 2 in der Spalte folgende Formel eingeben und für alle Zeilen nach unten kopieren
=WENN(B2=B1;D1;D1+1)
9. in der Spalte die Formeln durch die Werte ersetzen (Spalte markieren, kopieren, Inhalte einfügen...(Werte)
10. Falls erforderlich allte Sortierung wieder herstellen, alle Zeilen nach der Hilfsspalte (E) sortieren
11. Hilfsspalte wieder löschen.
Das nachfolgende Makro erledigt diese Schrittfolge, jedoch ohne den Weg über die Formeln, da das Ergebnis im Makro ermittelt und direkt der Rang eingetragen wird.
Gruß
Franz
Sub aaTest()
Dim wks As Worksheet, Zeile As Long, letzte As Long, Rang As Long, Zeile1 As Long
Zeile1 = 2 '1. Zeile, die in die Rangefolge einfließt, ggf anpassen!!
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
letzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Application.StatusBar = "Ich bin mit dem Erstellen der Rangfolgen beschäfftigt"
'hilfsweise alte Reihenfolge in Spalte 5 eintragen
For Zeile = Zeile1 To letzte
.Cells(Zeile, 5).Value = Zeile
Next
'sortieren nach X-Werten und Spalten berechnen
.Range(.Cells(Zeile1, 1), .Cells(letzte, 5)).Sort _
key1:=.Cells(Zeile1, 1), Order1:=xlAscending, Header:=xlNo
Rang = 1
.Cells(Zeile1, 3).Value = Rang
For Zeile = Zeile1 + 1 To letzte
If .Cells(Zeile, 1).Value = .Cells(Zeile - 1, 1).Value Then
.Cells(Zeile, 3).Value = Rang
Else
Rang = Rang + 1
.Cells(Zeile, 3).Value = Rang
End If
Next
'sortieren nach Y-Werten und Zeile berechnen
.Range(.Cells(Zeile1, 1), .Cells(letzte, 5)).Sort _
key1:=.Cells(Zeile1, 2), Order1:=xlAscending, Header:=xlNo
Rang = 1
.Cells(Zeile1, 4).Value = Rang
For Zeile = Zeile1 + 1 To letzte
If .Cells(Zeile, 2).Value = .Cells(Zeile - 1, 2).Value Then
.Cells(Zeile, 4).Value = Rang
Else
Rang = Rang + 1
.Cells(Zeile, 4).Value = Rang
End If
Next
Application.StatusBar = False
'sortieren nach ursprünglicher Reihenfolge
.Range(.Cells(Zeile1, 1), .Cells(letzte, 5)).Sort _
key1:=.Cells(Zeile1, 5), Order1:=xlAscending, Header:=xlNo
'Hilfsspalte wieder löschen
.Columns(5).Delete
Application.ScreenUpdating = True
'maximaler Spaltenwert
If Application.WorksheetFunction.Max(.Columns(3)) > .Columns.Count Then
MsgBox "Die eforderliche Spaltenanzahl " & _
Application.WorksheetFunction.Max(.Columns(3)) & _
" ist größer als die max. mögliche Anzahl Spalten in einer Tabelle!"
End If
End With
End Sub