Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 18:04:29
18.04.2024 16:33:24
Anzeige
Archiv - Navigation
1040to1044
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

schöneres Makro

schöneres Makro
18.01.2009 13:07:00
Steffen
Hallo forumsuser!
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: schöneres Makro
18.01.2009 13:37:00
Daniel
Hi
da die Zellbereiche alle gleich behandelt werden, könnte man die Zellbereiche in ein Array-Feld einlesen und dann per Schleife abarbeiten. Ebensso sind beide Makroteile gleich bis auf die Unterschiedliche Formel, dh hier könnte man auch die Formel in eine Array-Variable einlesen und eine 2. Schleife erstellen.

dim rng(3) as range
dim Formel(1) as string
dim i as long, x as long
set rng(0) = Range("A11:A20")
set rng(1) = Range("A24:A39")
set rng(2) = Range("H11:H20")
set rng(3) = Range("H24:H39")
formel(0) =  "=IF(RC[1]="""","""",ROW())"
formel(1) = "=COUNTIF(RC[2]:RC[6],""x"")"
for x = o to 1
for i = 0 to 3
with rng(i)
.FormulaR1C1 = Formel(x)
.formula = .value
.resize(,7).Sort Key1:=.cells(1,1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
end with
next i
next x
Range("H11:H39").ClearContents
Columns("A:A").Delete


Gruß, Daniel
ps. nicht getestet und auf Tippfehler geprüft, da keine Beispieldatei zum Testen vorhanden ist.

Anzeige
AW:korrektur
18.01.2009 13:42:00
Daniel
ups, hab grad gesehen, das sich die Sortierrichtung im 2. druchlauf ändert, dh du brauchst noch ne Array-Variable für die Sortierrichtung:

dim rng(3) as range
dim Formel(1) as string
dim i as long, x as long
dim SortRichtung as long
set rng(0) = Range("A11:A20")
set rng(1) = Range("A24:A39")
set rng(2) = Range("H11:H20")
set rng(3) = Range("H24:H39")
formel(0) =  "=IF(RC[1]="""","""",ROW())"
formel(1) = "=COUNTIF(RC[2]:RC[6],""x"")"
sortRichtung(0) = xlascending
sortRichtung(1) = xldescending

for x = o to 1
for i = 0 to 3
with rng(i)
.FormulaR1C1 = Formel(x)
.formula = .value
.resize(,7).Sort Key1:=.cells(1,1), Order1:=sortRichtung(x), Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
end with
next i
next x
Range("H11:H39").ClearContents
Columns("A:A").Delete


Gruß, Daniel

Anzeige
genau so:-) Danke! oT
18.01.2009 13:57:00
Steffen
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige