aufsteigend sortieren, aber Leerzellen ans Ende

Bild

Betrifft: aufsteigend sortieren, aber Leerzellen ans Ende
von: Jürgen
Geschrieben am: 27.10.2003 14:36:46

Hallo Leute,
ich habe eine Tabelle mit verknüpften Werten aus einer anderen Tabelle.
Einen speziellen Bereich dieser Tabelle möchte ich per VBA automatisch beim öffnen aufsteigend sortieren, wobei aber die Leerzellen ans Ende des Sortierbereichs gestellt werden sollen.
Habs mit folgendem Code versucht:


Sub SortierenAufsteigend()
  Worksheets("kurz").Range("A7:K47").Sort Key1:=Range("A7"), _
      Order1:=xlAscending, Header:=xlYes, MatchCase:=False, OrderCustom:=1,     
      Orientation:=xlTopToBottom 
  End Sub


so stellt er mir die Leerzeilen an den Anfang
Weiß jemand Rat??
Vielen Dank im voraus.
Gruß Jürgen
Bild


Betrifft: AW: aufsteigend sortieren, aber Leerzellen ans Ende
von: WernerB.
Geschrieben am: 27.10.2003 15:42:57

Hallo Jürgen,

kopiere den nachstehenden Code in das Modul von "DieseArbeitsmappe", dann sollte es klappen:

Private Sub Workbook_Open()
    With Worksheets("kurz")
      .Range("A7:K47").Sort Key1:=.Range("A7"), _
      Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom
    End With
End Sub

Viel Erfolg wünscht
WernerB.

P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).


Bild


Betrifft: AW: aufsteigend sortieren, aber Leerzellen ans Ende
von: Jürgen
Geschrieben am: 27.10.2003 16:30:22

Hi Werner,
zunächst vielen Dank für Deine schnelle Antwort.
Hab den Code in "Diese Arbeitsmappe" eingefügt und die Mappe erneut geöffnet.
Resultat: Der Bereich wurde automatisch sortiert, aber die Leerzeilen stehen wieder
am Anfang und nicht, wie erwünscht am Ende des Bereiches.
Gibt es zu diesem Problem eine Lösung??
Danke und Grüße
Jürgen


Bild


Betrifft: AW: aufsteigend sortieren, aber Leerzellen ans Ende
von: WernerB.
Geschrieben am: 28.10.2003 07:33:39

Hallo Jürgen,

offenbar handelt es sich bei den "leeren" Zellen der Spalte "A" nicht um tatsächlich leere Zellen, sondern um solche, die Formeln beinhalten, die den Wert "0" zurückliefern; dabei hast Du die Null-Anzeige ausgeblendet.
Wenn dem so ist, dann sollte dieses Makro funktionieren:

Private Sub Workbook_Open()
Dim i As Integer, laR As Integer
    Application.ScreenUpdating = False
    With Worksheets("kurz")
      .Range("A7:K47").Sort Key1:=.Range("A7"), _
      Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom
    laR = 47
    For i = 47 To 1 Step -1
      If .Cells(i, 1).Text <> "" Then
        laR = i
        Exit For
      End If
    Next i
      .Range("A7:K" & laR).Sort Key1:=.Range("A7"), _
      Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom
    Application.ScreenUpdating = True
    End With
End Sub

Gruß WernerB.


Bild


Betrifft: Vielen Dank! noch ne klein Frage:)
von: Jürgen
Geschrieben am: 28.10.2003 09:20:30

Hi Werner,
zunächst nochmals vielen Dank. Dieser Code löst genau meine Aufgabe!
Meine Frage ist jetzt noch: Ich muss diese Sortierfunktion in der Tabelle für 12 verschiedene Bereiche beim Starten durchführen. Muss ich den Code 12mal mit den jeweilgen Range-Angaben eingeben oder gibt es da eine kürzere Variante?
Gruß Jürgen


Bild


Betrifft: AW: Vielen Dank! noch ne klein Frage:)
von: WernerB.
Geschrieben am: 28.10.2003 12:35:39

Hallo Jürgen,

ohne Dein Tabellenblatt zu kennen, kann ich die Frage nicht klar beantworten.
Möglicherweise kann man das mit einer Schleife lösen, z.B. wenn die Bereiche immer gleich groß sind und auch den selben Abstand zueinander haben.
Schreibe die restlichen elf Bereichsadressen ("A7:K47") mal hier ins Forum, dann kann man sich darüber auch Gedanken machen.


Gruß WernerB.


Bild


Betrifft: AW: Vielen Dank! noch ne klein Frage:)
von: Jürgen
Geschrieben am: 28.10.2003 13:10:22

Hi Werner,
ich hab vorerst den Code 12 mal kopiert und die Bereiche entsprechend geändert. Die Sortierung funktioniert für alle 12 Bereiche, allerdings flackert bei der Ausführung der Bildschirm heftig.

Hier die 12 Bereiche:

A7:K47 ; A53:K93 ; A99:K139 ; A145:K185 ; A191:K231 ; A237:K277 ; A283:K323 ; A329:K369 ; A375:K415 ; A421:K461 ; A467:K507 ; A513:K553

Die Bereiche sind immer gleich groß.
Viele Grüße Jürgen


Bild


Betrifft: AW: Vielen Dank! noch ne klein Frage:)
von: WernerB.
Geschrieben am: 28.10.2003 13:24:27

Hallo Jürgen,

das Flackern sollte nicht sein, wenn nur am Anfang
Application.ScreenUpdating = False

steht und am Ende
Application.ScreenUpdating = True

Dazwischen sollten diese Anweisungen nicht stehen.

Deine Bereichsadressen muss ich erst mal auf mich wirken lassen.


Gruß WernerB.


Bild


Betrifft: Jetzt ises perfekt! Tsd Dank!
von: Jürgen
Geschrieben am: 28.10.2003 13:39:27

Hi Werner,
das war die Lösung!
Hab dummerweise die Anweisung: Application.ScreenUpdating = True
zwölf mal mitkopiert. Elf mal gelöscht und jetzt flackert nichts mehr!!
Hast mir wirklich sehr geholfen! Nochmals Tausend Dank.
Ist auch nicht tragisch wenn dir zu dem langen Code auf die schnelle nichts einfällt. Es funktioniert auch so prächtig!
Viele sonnige Grüße
Jürgen


Bild


Betrifft: AW: Jetzt ises perfekt! Tsd Dank!
von: WernerB.
Geschrieben am: 28.10.2003 13:49:52

Hallo Jürgen,

hier die von mir bereits angedeutete Schleifenlösung:

Private Sub Workbook_Open()
Dim i As Integer, j As Integer, laR As Integer, a As Integer, k As Integer
    Application.ScreenUpdating = False
    With Worksheets("kurz")
    a = 7
    k = 47
    For j = 1 To 12
      .Range("A" & a & ":K" & k).Sort Key1:=.Range("A" & a), _
        Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
      laR = k
      For i = k To a Step -1
        If .Cells(i, 1).Text <> "" Then
          laR = i
          Exit For
        End If
      Next i
      .Range("A" & a & ":K" & laR).Sort Key1:=.Range("A" & a), _
        Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
      a = a + 46
      k = k + 46
    Next j
    End With
    Application.ScreenUpdating = True
End Sub

Gruß WernerB.


Bild


Betrifft: AW: Jetzt ises perfekt! Tsd Dank!
von: Jürgen
Geschrieben am: 28.10.2003 16:12:58

Hi Werner,
hab den neuen Code eingesetzt und kann berichten: läuft absolut problemlos
und ist natürlich wesentlich kürzer als die vorige Version.

Ich kanns nur wiederholen: Tausend Dank für Deine Hilfe
und viele Grüße
Jürgen


 Bild

Beiträge aus den Excel-Beispielen zum Thema " aufsteigend sortieren, aber Leerzellen ans Ende"