Das funktioniert doch ...
21.01.2012 09:22:02
Matthias
Hallo Tom
Ich hatte Dir bereits die Lösung als Datei gepostet!
Tabelle
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H4:h18")) Is Nothing Then
Call Modul3.Tabelle_Vorrunde_Sortieren_A
End If
If Not Intersect(Target, Range("t4:t18")) Is Nothing Then
Call Modul3.Tabelle_Vorrunde_Sortieren_B
End If
If Not Intersect(Target, Range("H32:h46")) Is Nothing Then
Call Modul3.Tabelle_Vorrunde_Sortieren_C
End If
If Not Intersect(Target, Range("t32:t46")) Is Nothing Then
Call Modul3.Tabelle_Vorrunde_Sortieren_D
End If
End Sub
Modul3
Option Explicit
Public Rng As Range
Sub Tabelle_Vorrunde_Sortieren_A()
Range("H4:H18").Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlGuess
For Each Rng In Range("H4:H18")
If Rng.Value = "" Then Rng.Select: Exit For
Next
End Sub
Sub Tabelle_Vorrunde_Sortieren_B()
Range("t4:t18").Sort Key1:=Range("t4"), Order1:=xlAscending, Header:=xlGuess
For Each Rng In Range("t4:t18")
If Rng.Value = "" Then Rng.Select: Exit For
Next
End Sub
Sub Tabelle_Vorrunde_Sortieren_C()
Range("H32:H46").Sort Key1:=Range("H32"), Order1:=xlAscending, Header:=xlGuess
For Each Rng In Range("H32:H46")
If Rng.Value = "" Then Rng.Select: Exit For
Next
End Sub
Sub Tabelle_Vorrunde_Sortieren_D()
Range("t32:t46").Sort Key1:=Range("t32"), Order1:=xlAscending, Header:=xlGuess
For Each Rng In Range("t32:t46")
If Rng.Value = "" Then Rng.Select: Exit For
Next
End Sub
Wobei Du Header auch auf XlNo setzen könntest
Das in Block C und D für Dich der Cursor anscheinend nicht in der richtige Zelle platziert wird, liegt ganz einfach daran das in diesen Blöcken je eine Zelle einen Leerstring hat. Der wird mitsortiert.
Ich hatte nur nach dem Testen die Zellen nicht wieder geleert. Sorry fürs Verwirren ;o)
In Block C in Zelle H35
In Block D in Zelle T34
Mit der Formel: Länge(DeineZelle) in den jeweiligen Nachbarzellen hattest Du das auch selbst herausgefinden können ;o)
Gruß Matthias