Zellen sortieren + leere Zellen ignorieren

Sub Sortalpha() Dim zelle As Range Rows("2:101").Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, dataoption1:=xltextasnumbers Set zelle = Columns("A:A").Find(What:="", After:=[a1], LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False) If Not zelle Is Nothing Then Rows("2:" & zelle.Row - 1).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, dataoption1:=xltextasnumbers End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Sort_Zahlen_Text_Leer_abst() Dim lngZ, Calc As XlCalculation Const Spalt = 1 ' Spalte, nach der sortiert werden soll Calc = Application.Calculation Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual ' -------------------------------------------------------- Sortspalte generieren lngZ = Cells(Rows.Count, Spalt).End(xlUp).Row Columns(Spalt).Insert Cells(1, Spalt) = "SortKey" Range(Cells(2, Spalt), Cells(lngZ, 1)).FormulaR1C1 = "=IF(ISBLANK(RC[1])," & _ """a""&RC[1]," & "IF(ISNUMBER(RC[1]),""c""&TEXT(RC[1],""000000000,000""),""b""&RC[1]))" ' -------------------------------------------------------- Sortieren Cells(1, Spalt).Sort Key1:=Cells(1, Spalt), Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ' -------------------------------------------------------- Aufräumen Columns(Spalt).Delete Application.Calculation = Calc Application.EnableEvents = True Application.ScreenUpdating = True End Sub

Option Explicit Sub Sort_Zahlen_Text_Leer_abst() Dim lngZ, Calc As XlCalculation Const intS = 1 ' Spalte, nach der sortiert werden soll Const strF = "000000,000" ' Zahlenformat mit max. Anzahl Vor- und Nachkommastellen Calc = Application.Calculation Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual ' -------------------------------------------------------- Sortspalte generieren lngZ = Cells(Rows.Count, intS).End(xlUp).Row Columns(intS).Insert Cells(1, intS) = "SortKey" Range(Cells(2, intS), Cells(lngZ, 1)).FormulaLocal = "=WENN(ISTLEER(B2);" & """a""&B2;" _ & "WENN(ISTZAHL(B2);WENN(B2<0;""c"";""d"")&TEXT(B2;""" & strF & """);" & """b""&B2))" ' -------------------------------------------------------- Sortieren Cells(1, intS).Sort Key1:=Cells(1, intS), Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ' -------------------------------------------------------- Aufräumen Columns(intS).Delete Application.Calculation = Calc Application.EnableEvents = True Application.ScreenUpdating = True End Sub

Option Explicit Sub Test_Sort_var() Call Sort_var(1, 1, True, "Abend") Stop Call Sort_var(1, 2, True, "Nacht") Stop Call Sort_var(1, 1, True, "excel") End Sub ' 23.01.2007 Erich G. Sub Sort_var(intSp As Integer, intO As Integer, bolGk As Boolean, strSo As String) ' | | | 5 Zeichen für die Typen: ' | | | 1. Zahl ' | | | 2. Text + restl. Typen ' | | | 3. Wahrheitswert ' | | | 4. Fehlerwert ' | | | 5. leere Zelle ' | | True/False für MatchCase ' | 1 für aufsteigend, 2 für absteigend ' Nr. der Spalte, nach der sortiert werden soll Dim TT(1 To 5) As String, lngZ As Long, Calc As XlCalculation If Len(strSo) <> 5 Then Exit Sub For lngZ = 1 To 5: TT(lngZ) = Mid(strSo, lngZ, 1): Next lngZ Calc = Application.Calculation Application.ScreenUpdating = False: Application.EnableEvents = False Application.Calculation = xlCalculationManual ' -------------------------------------------------------- Sortspalte generieren lngZ = Cells(Rows.Count, intSp).End(xlUp).Row Columns(intSp).Insert: Cells(1, intSp) = "SKey1" Range(Cells(2, intSp), Cells(lngZ, intSp)).FormulaLocal = _ "=WENN(ISTZAHL(B2);""" & TT(1) & """;" _ & "WENN(ISTLOG(B2);""" & TT(3) & """;" _ & "WENN(ISTFEHLER(B2);""" & TT(4) & """;" _ & "WENN(ISTLEER(B2);""" & TT(5) & """;""" & TT(2) & """))))" ' -------------------------------------------------------- Sortieren nach 2 Spalten Cells(1, intSp).Sort _ Key1:=Cells(1, intSp), Order1:=xlAscending, Key2:=Cells(1, intSp + 1), Order2:=intO, _ Header:=xlYes, OrderCustom:=1, MatchCase:=bolGk, Orientation:=xlTopToBottom ' -------------------------------------------------------- Aufräumen Columns(intSp).Delete Application.Calculation = Calc Application.EnableEvents = True: Application.ScreenUpdating = True End Sub

Option Explicit Sub Test_Sort_varU() Call Sort_varU(4, 7, 3, 2, True, "abxxc") End Sub ' 24.01.2007 Erich G. Sub Sort_varU(intU As Integer, intAS As Integer, intSp As Integer, _ intO As Integer, bolGk As Boolean, strSo As String) ' Parameter: ' 1. intU Anzahl Zeilen für Spaltenüberschriften ' 2. intAS Nr. der letzten mitzusortierenden Spalte ' 3. intSp Nr. der Spalte, nach der sortiert werden soll ' 4. intO 1 für aufsteigend, 2 für absteigend ' 5. bolGk True/False für Groß-/Kleinschreibung beachten (MatchCase) ' 6. strSo 5 Zeichen für die Datentypen ' 1. Zahl ' 2. Text (+ evtl. restliche Datentypen) ' 3. Wahrheitswert ' 4. Fehlerwert ' 5. leere Zelle Dim TT(1 To 5) As String, lngZ As Long, Calc As XlCalculation If Len(strSo) <> 5 Then Exit Sub If intSp > intAS Then Exit Sub If intAS >= Columns.Count Then Exit Sub For lngZ = 1 To 5: TT(lngZ) = Mid(strSo, lngZ, 1): Next lngZ Calc = Application.Calculation Application.ScreenUpdating = False: Application.EnableEvents = False Application.Calculation = xlCalculationManual ' -------------------------------------------------------- Sortspalte generieren lngZ = Cells(Rows.Count, intSp).End(xlUp).Row Columns(intSp).Insert: Cells(intU, intSp) = "SKey1" Range(Cells(intU + 1, intSp), Cells(lngZ, intSp)).FormulaLocal = _ "=WENN(ISTZAHL(B2);""" & TT(1) & """;" _ & "WENN(ISTLOG(B2);""" & TT(3) & """;" _ & "WENN(ISTFEHLER(B2);""" & TT(4) & """;" _ & "WENN(ISTLEER(B2);""" & TT(5) & """;""" & TT(2) & """))))" ' -------------------------------------------------------- Sortieren nach 2 Spalten Range(Cells(intU, 1), Cells(lngZ, intAS + 1)).Sort _ Key1:=Cells(intU, intSp), Order1:=xlAscending, _ Key2:=Cells(intU, intSp + 1), Order2:=intO, _ Header:=xlYes, OrderCustom:=1, MatchCase:=bolGk, Orientation:=xlTopToBottom ' -------------------------------------------------------- Aufräumen Columns(intSp).Delete Application.Calculation = Calc Application.EnableEvents = True: Application.ScreenUpdating = True End Sub

Hallo Markus,
sorry, ich hab das mit der Spalte B erst jetzt gefunden!
Also noch mal:
Der folgende Aufruf ist für
- 4 Zeilen für die Spaltenüberschriften
- 7 Spalten (A bis G) werden sortiert
- sortiert wird nach Spalte C (3)
- absteigend (2)
- Groß-/Kleinschr. wird berücksichtigt (bei gleichen Buchstaben erst klein, dann groß)
- Zahlen (a) vor Texten (b) vor Leerzellen (c)
- andere Typen (x) kommen nicht vor, würden ans Ende sortiert

Option Explicit
Sub Test_Sort_varU()
Call Sort_varU(4, 7, 3, 2, True, "abxxc")
End Sub
' 23.01.2007 Erich G.
Sub Sort_varU(intU As Integer, intAS As Integer, intSp As Integer, _
intO As Integer, bolGk As Boolean, strSo As String)
'  Parameter:
'  1. intU   Anzahl Zeilen mit Spaltenüberschriften
'  2. intAS  Nr. der letzten mitzusortierenden Spalte
'  3. intSp  Nr. der Spalte, nach der sortiert werden soll
'  4. intO   1 für aufsteigend, 2 für absteigend
'  5. bolGk  True/False für Groß-/Kleinschreibung beachten (MatchCase)
'  6. strSo  5 Zeichen für die Datentypen
'              1. Zahl
'              2. Text (+ evtl. restliche Datentypen)
'              3. Wahrheitswert
'              4. Fehlerwert
'              5. leere Zelle
Dim TT(1 To 5) As String, lngZ As Long, Calc As XlCalculation, strZ As String
If Len(strSo) <> 5 Then Exit Sub
If intSp > intAS Then Exit Sub
If intAS >= Columns.Count Then Exit Sub
For lngZ = 1 To 5:    TT(lngZ) = Mid(strSo, lngZ, 1):    Next lngZ
Calc = Application.Calculation
Application.ScreenUpdating = False:   Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'  -------------------------------------------------------- Sortspalte generieren
lngZ = Cells(Rows.Count, intSp).End(xlUp).Row
Columns(intSp).Insert:   Cells(intU, intSp) = "SKey1"
strZ = Cells(intU + 1, intSp + 1).Address(0, 0)
Range(Cells(intU + 1, intSp), Cells(lngZ, intSp)).FormulaLocal = _
"=WENN(ISTZAHL(" & strZ & ");""" & TT(1) & """;" _
& "WENN(ISTLOG(" & strZ & ");""" & TT(3) & """;" _
& "WENN(ISTFEHLER(" & strZ & ");""" & TT(4) & """;" _
& "WENN(ISTLEER(" & strZ & ");""" & TT(5) & """;""" & TT(2) & """))))"
'  -------------------------------------------------------- Sortieren nach 2 Spalten
Range(Cells(intU, 1), Cells(lngZ, intAS + 1)).Sort _
Key1:=Cells(intU, intSp), Order1:=xlAscending, _
Key2:=Cells(intU, intSp + 1), Order2:=intO, _
Header:=xlYes, OrderCustom:=1, MatchCase:=bolGk, Orientation:=xlTopToBottom
'  -------------------------------------------------------- Aufräumen
Columns(intSp).Delete
Application.Calculation = Calc
Application.EnableEvents = True:   Application.ScreenUpdating = True
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Zellen sortieren + leere Zellen ignorieren

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen sortieren + leere Zellen ignorieren

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread