schöneres Makro
18.01.2009 13:07:00
Steffen
ich habe nachfolgendes makro "zusammengebastelt",es funktioniert auch zufriedenstellend nur ist es eben zusammen "gewurschtelt".
Diese makro sortiert namen und eigenschafften in ein arbeitsblatt in zellen ,diese zellen sind mit formeln belegt welche die namen und eigenschaften suchen und dementsprechend namen und eigenschaften eintragen od auch nicht somit enstehen leere zellen die vorher herrausgefilert werden müssen.
Das ergebniss ist ,daß die namen mit den meisten eigenschaften abfallend sortiert werden.
`Leere Zellen werden ausgefiltert
Columns("A:A").Insert
Union(Range("A11:A20"), Range("A24:A39"), Range("H11:H20"), Range("H24:H39")).FormulaR1C1 = "=IF(RC[1]="""","""",ROW())"
Range("A11:A20").Value = Range("A11:A20").Value
Range("A24:A39").Value = Range("A24:A39").Value
Range("H11:H20").Value = Range("H11:H20").Value
Range("H24:H39").Value = Range("H24:H39").Value
Range("A11:G20").Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A23:G39").Sort Key1:=Range("A23"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H10:N20").Sort Key1:=Range("H10"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H24:N39").Sort Key1:=Range("H23"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H11:H39").ClearContents
`Es werden die namen sortiert mit den meisten eigenschaften "x"
Union(Range("A11:A20"), Range("A24:A39"), Range("H11:H20"), Range("H24:H39")).FormulaR1C1 = "=COUNTIF(RC[2]:RC[6],""x"")"
Range("A11:A20").Value = Range("A11:A20").Value
Range("A24:A39").Value = Range("A24:A39").Value
Range("H11:H20").Value = Range("H11:H20").Value
Range("H24:H39").Value = Range("H24:H39").Value
Range("A11:G20").Sort Key1:=Range("A11"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A23:G39").Sort Key1:=Range("A23"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H10:N20").Sort Key1:=Range("H10"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H24:N39").Sort Key1:=Range("H24"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H11:H39").ClearContents
Columns("A:A").Delete
.....sicherlich fällt euch hierzu ein schönes ,kürzeres marko ein.
Danke schon mal und ich bin gespannt auf eure vorschläge!
grüße steffen