Herbers Excel-Forum - das Archiv

VBA Sortierfunktion

Bild

Betrifft: VBA Sortierfunktion
von: Uwe T.

Geschrieben am: 27.12.2006 22:49:20
Hallo,
ich suche ein Makro, das nur unter bestimmten Bedingungen sortiert. Als Beispiel habe ich eine Exceldatei erstellt.
https://www.herber.de/bbs/user/39208.xls
In Spalte B ist die Nummerierungsreihenfolge und in Spalte D steht Text. Die Sortierfunktion soll nur ausgeführt werden, wenn dem Text eine Nummer zugeordnet wurde. Andernfalls zerhauts die Tabelle. Könnt Ihr mir helfen?
Vielen Dank schon mal.
Grüße
Uwe
Bild

Betrifft: AW: VBA Sortierfunktion
von: Erich G.

Geschrieben am: 28.12.2006 07:57:46
Hallo Uwe,
probier mal
Option Explicit
Sub sortieren()
Dim lngD As Long
If Not IsEmpty(Cells(150, 4)) Then lngD = 150 Else lngD = Cells(150, 4).End(xlUp).Row
If Application.Evaluate( _
"SUMPRODUCT(ISBLANK(B19:B" & lngD & ")*(1-ISBLANK(D19:D" & lngD & ")))") = 0 Then
Application.ScreenUpdating = False
Rows("19:150").Select
Range("B19").Activate   ' nötig?
Selection.Sort Key1:=Range("B19"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End If
End Sub
Dabei sind auch Zeilen zugelassen, in denen D leer ist oder B und D leer sind.
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht allen einen guten Rutsch!
Bild

Betrifft: AW: VBA Sortierfunktion
von: Uwe

Geschrieben am: 28.12.2006 13:48:41
Hallo Erich,
vielen Dank. Makro funktioniert. Nun hat sich aber noch ein weiteres Problem aufgetan.
Ich bräuchte nun noch ein Makro, das Prüft, ob eine Nummerierung in Spalte B doppelt vorkommt. Dies darf nämlich nicht sein. Aus diesem Grund darf bei doppelter Nummernvergabe die Sortierfunktion auch nicht ausgeführt werden.
Hast du dafür evtl. auch eine Lösung?
Auf jeden Fall schon mal vielen Dank.
Gruß
Uwe
Bild

Betrifft: AW: VBA Sortierfunktion
von: Erich G.

Geschrieben am: 28.12.2006 18:27:22
Hallo Uwe,
das ginge (hoffentlich - kaum getestet!) so:
Option Explicit
Sub sortierenBed()
Dim lngD As Long
If Not IsEmpty(Cells(150, 2)) Then lngD = 150 Else lngD = Cells(150, 2).End(xlUp).Row
If Application.Evaluate( _
"SUMPRODUCT(1*(COUNTIF(B19:B" & lngD & ",B19:B" & lngD & ")>=2))") = 0 Then
If Not IsEmpty(Cells(150, 4)) Then lngD = 150 Else lngD = Cells(150, 4).End(xlUp).Row
If Application.Evaluate( _
"SUMPRODUCT(ISBLANK(B19:B" & lngD & ")*(1-ISBLANK(D19:D" & lngD & ")))") = 0 Then
Application.ScreenUpdating = False
Rows("19:150").Select
Range("B19").Activate   ' nötig?
Selection.Sort Key1:=Range("B19"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
Else
MsgBox "Keine Sortierung - mind. eine Zuordnung fehlt", vbExclamation
End If
Else
MsgBox "Keine Sortierung - mind. ein Wert in Spalte B kommt doppelt vor", vbExclamation
End If
End Sub
Möchtest du als Nächstes, dass die Doppelten in Spalte B markiert werden? ;-)
Ist Range("B19").Activate nötig?
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht allen einen guten Rutsch!
Bild

Betrifft: AW: VBA Sortierfunktion
von: Uwe

Geschrieben am: 28.12.2006 21:02:09
Hallo Erich,
entschuldige meine Ungeduld. Dein Makro funktioniert einwandfrei, so dass ich mich wieder frisch ans Werk machen kann.
Mit der doppelten Markierung ist gar keine schlechte Idee (auch wenn sie evtl. etwas ironisch gemeint war), denn der eigentliche Bereich geht bis Zeile 1500 und es könnte ein bisschen dauern, bis man die Fehler entdeckt hat. Aber ich denke, dass ich diese Bedingung nicht gebrauchen werden.
Range("B19").Activate ist nicht nötig. Ich arbeite noch viel mit der Aufzeichnen-Funktion, da ich nicht besonders fit im Makroschreiben bin.
Also nochmals vielen Dank und ebenfalls einen guten Rutsch ins neue Jahr.
Gruß
Uwe
 Bild
Excel-Beispiele zum Thema "VBA Sortierfunktion"
Auf- und absteigend sortieren ohne Sortierfunktion