Anzeige
Archiv - Navigation
832to836
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
832to836
832to836
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Sortierfunktion

VBA Sortierfunktion
27.12.2006 22:49:20
Uwe
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Sortierfunktion
28.12.2006 07:57:46
Erich
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!
Anzeige
AW: VBA Sortierfunktion
28.12.2006 13:48:41
Uwe
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
AW: VBA Sortierfunktion
28.12.2006 18:27:22
Erich
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!
Anzeige
AW: VBA Sortierfunktion
28.12.2006 21:02:09
Uwe
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige