Markieren nach Sortieren

Bild

Betrifft: Markieren nach Sortieren
von: Franz W.
Geschrieben am: 25.09.2003 18:43:45

Hallo Fachleute,

ich habe folgende Frage: in eine Tabelle werden in eine neue Zeile am Ende Werte eingetragen, der letzte ist das aktuelle Datum in Spalte D. Dann wird mit nachfolgendem Makro nach der Spalte A aufsteigend sortiert.



Sub Sortieren()
Dim ws As Worksheet
Dim a&, b As Byte
Dim RaBereich As Range
Dim r As Range
''' Bereich der Wirksamkeit:
    Set ws = ActiveSheet
    If Range("C65536") = "" Then a = Range("C65536").End(xlUp).Row Else: a = 65536
    b = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
''' Sortieren:
    Set RaBereich = Range(Cells(4, 1), Cells(a, b))
    RaBereich.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("C4"), _
        Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
    Application.ScreenUpdating = True
''' Zelle mit aktuellem Datum finden:
'    Set r = Cells.Find(Date)
'    If Not r Is Nothing Then
'        r.Select
'        Exit Sub
'    End If
'    Range("A4").Select
End Sub


Im Anschluss an das Sortieren hätte ich gerne, dass genau die Zelle mit dem Datum, das als letzte eingetragen wurde markiert ist, egal in welcher Zeile diese Zelle nach dem Sortieren jetzt steht. (Mit dem auskommentierten Teil in meinem bisherigen Code habe ich nach dem aktuellen Datum gesucht. Das klappt aber nur, wenn am Tage nur ein einziger Eintrag gemacht wurde was nicht der Fall ist!)

Als Alternative wäre ok, wenn die ganze Zeile, die als letzte eingetragen wurde, markiert ist.

Ich hoffe ich konnte erklären, worum es mir geht. Hat dafür jemand eine Idee für einen Ansatz?

Vielen Dank schon mal und Grüße
Franz
Bild


Betrifft: AW: Markieren nach Sortieren
von: Nepumuk
Geschrieben am: 25.09.2003 18:47:38

Hallo Franz,
ist einer der Einträge in den anderen Spalten exklusiv?
Gruß
Nepumuk


Bild


Betrifft: Ja
von: Franz W.
Geschrieben am: 25.09.2003 18:50:25

Hallo Nepumuk,

ja, in Spalte C steht ein KFZ-Kennzeichen, das es in der ganzen Liste nur einmal gibt.

Grüße
Franz


Bild


Betrifft: AW: Ja
von: Nepumuk
Geschrieben am: 25.09.2003 19:04:31

Hallo Franz,
so geht's auch:

Option Explicit
Public neuer_Eintrag As String
Sub Sortieren()
    Dim zelle As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Range("A4:D65536").Sort Key1:=Range("A4"), Key2:=Range("C4")
    Set zelle = Columns("C:C").Find(neuer_Eintrag)
    If Not zelle Is Nothing Then
        Range(zelle.Address).Offset(10, 1).Select
    Else
        Range("A4").Select
    End If
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


In das Klassenmodul der Tabelle folgenden Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 3 Then neuer_Eintrag = Target
End Sub


Code eingefügt mit: Excel Code Jeanie


Gruß
Nepumuk


Bild


Betrifft: Leider noch nicht
von: Franz W.
Geschrieben am: 25.09.2003 19:22:40

Hallo Nepumuk,

vielen Dank für Deine Lösung, schaut ja toll aus. Und das mal wieder in ein paar Minuten. Hab für meines gestern bald 'ne Stunde gebraucht.

Aber leider klappts noch nicht ganz: er sortiert zwar richtig. Aber er selektiert immer eine falsche Zelle, und zwar die Zelle D12.


Ich habe jetzt mal vier neue Einträge gemacht, und zwar in Zeilen > 40.

Der erste Eintrag steht nach dem Sortieren in Zeile 33 (richtig), selektiert ist D12.
Der zweite Eintrag steht nun in Zeile 41 (richtig), selektiert D12.
Der dritte Eintrag steht richtig in Zeile 43, markiert ist D12.
Den vierten Eintrag hab ich mal so gewählt, dass er als letzte Zeile der ganzen Liste zu stehen hat. Das tut er auch nach dem Sortieren auch, aber selektiert ist wiederum D12.

Hast Du 'ne Idee?

Grüße
Franz


Bild


Betrifft: AW: Leider noch nicht
von: Nepumuk
Geschrieben am: 25.09.2003 19:29:50

Hallo Franz,
mein Fehler. So sollte die Anweisung eigentlich lauten:

Range(zelle.Address).Offset(0, 1).Select

Gruß
Nepumuk


Bild


Betrifft: Jetzt markiert er D2...
von: Franz W.
Geschrieben am: 25.09.2003 19:50:04

Hallo Nepumuk,

das mit Offset(10, 1) hab ich ja komplett übersehen... :-))

Und jetzt hab ich was eingetragen, was in die Zeile 33 gehört. Und da steht es auch nach dem Sortieren. Aber jetzt selektiert er D2, also oberhalb des sortierten Bereiches!

Grüße
Franz


Bild


Betrifft: AW: Jetzt markiert er D2...
von: Nepumuk
Geschrieben am: 25.09.2003 19:53:32

Hallo Franz,
ist die zweite Prozedur auch im Klassenmodul der Tabelle? (Rechtsklick auf den Tabellenreiter - Code anzeigen und das Programm in das sich öffnende Editorfenster kopieren)
Gruß
Nepumuk


Bild


Betrifft: AW: Jetzt markiert er D2...
von: Franz W.
Geschrieben am: 25.09.2003 20:15:22

Hallo Nepumuk,

entschuldige, stehe auf der Leitung: was meinst Du mit "die zweite Prozedur" ? Ich probiere momentan nur die eine. Und es macht keinen Unterschied, ob ich diese so aufrufe:


Private Sub cmbSortieren_Click()
    Call Sortieren
End Sub


oder direkt aus dem normalen Modul

?!?!?!?

Grüße
Franz


Bild


Betrifft: AW: Jetzt markiert er D2...
von: Nepumuk
Geschrieben am: 25.09.2003 20:18:02

Hallo Franz,
diesen Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 3 Then neuer_Eintrag = Target
End Sub



Gruß
Nepumuk


Bild


Betrifft: Perfekt!
von: Franz W.
Geschrieben am: 25.09.2003 20:35:58

Hallo Nepumuk,

Du hast ja Tricks drauf! Super, so klappt's!! Hab's noch nicht ganz kapiert, komm aber schon dahinter.

Ganz vielen Dank und beste Grüße
Franz


Bild


Betrifft: AW: Markieren nach Sortieren
von: PeterW
Geschrieben am: 25.09.2003 18:49:23

Hallo Franz,

warum gibst du nicht Datum UND Uhrzeit ein?

Gruß
Peter


Bild


Betrifft: Stimmt! Gute Idee! Danke Peter! o.T.
von: Franz W.
Geschrieben am: 25.09.2003 18:55:05




Bild


Betrifft: AW: Markieren nach Sortieren
von: Koenig W.
Geschrieben am: 25.09.2003 18:58:43

Hallo zusammen,
der Ansatz scheint mir gut,
vor sortieren den Zellwert der Datumszeile in eine Variable ablegen, nach dem Sortieren mit find(Variable) suchen, wäre dann auch gleich markiert.
Gruss Wilhelm


Bild


Betrifft: AW: Markieren nach Sortieren
von: Franz W.
Geschrieben am: 25.09.2003 19:05:09

Hallo Wilhelm,

wenn ich Deinen Vorschlag richtig verstehe, ist es ähnlich dem, was ich bisher verwendet habe: das was er findet ist das aktuelle Datum. Das markiert er und macht Schluss. Das aktuelle Datum steht aber öfters in der Spalte D! Und er markiert das erste, das er von oben her findet. Das ist aber nicht zwangsläufig auch das, das als letztes eingetragen wurde, sortiert wird ja ncith nach Datum, sondern es muss nach Spalte A sortiert werden.

Ich glaube, Nepumuks oder Peters Ideen sind schon richtig.

Trotzdem danke für Deine Hilfe und Grüße
Franz


Bild


Betrifft: Nachfrage @ Nepumuk
von: Franz W.
Geschrieben am: 25.09.2003 21:19:16

Hallo Nepumuk,

wenn Du noch mal magst, hätte ich noch eine Erweiterung, jetzt kommt bei mir ein weiterer Schritt:

Das was ich grad eben von Dir bekommen habe, klappt bestens! Das steht!

Nun möchte ich das mit einem Code von mir kombinieren, und das schaut dann so aus:


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 3 Then neuer_Eintrag = Target
    Application.ScreenUpdating = False
    ' Bereich der Wirksamkeit
    Set ws = ActiveSheet
    If Range("C65536") = "" Then a = Range("C65536").End(xlUp).Row Else: a = 65536
    b = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
    intCol = 4
    If Not Target.Column = 3 Then Exit Sub
        For iRow = a - 1 To 1 Step -1
            If WorksheetFunction.CountIf(Columns(3), Cells(iRow, 3)) > 1 Then
                Do Until IsEmpty(Cells(iRow, intCol))
                   intCol = intCol + 1
                Loop
                Cells(iRow, intCol) = Date
                Rows(a).ClearContents
                Exit Sub
            ElseIf Target = "" Then
                Exit Sub
            Else
                Cells(a, intCol) = Date
            End If
        Next iRow
Application.ScreenUpdating = True
Call Sortieren
End Sub


Das Makro "Sortieren" ist exakt das von Dir, daran hab ich jetzt nichts mehr geändert (außer: " Range("A4:G65536").Sort ... ", weil die Liste bis Spalte G geht).

Hier wird also bei einem Neueintrag nach Verlassen der Spalte C automatisch in Spalte D derselben Zeile das aktuelle Datum eingetragen. Danach wird geprüft, ob das eben eingetragene Kennzeichen schon existiert. Falls nein, klappt auch das Sortieren und Markieren des Datums des letzten Eintrages perfekt.

Also bei:

Else
Cells(a, intCol) = Date
End If
..., also bei Eintrag eines noch nicht vorhandenen Kfz-Kennzeichens in Spalte C.


In dem anderen Fall - Eintrag eines Fahrzeugs mit bereits in der Liste existierenden Kennzeichens - klappt zwar der Eintrag des Datums in die nächste Spalte bei dem bereits vorhandenen Eintrag. Was allerdings jetzt nicht mehr hinhaut, ist das Markieren genau dieses Datums. Kann ja auch nicht, so wie ich das verstehe.

Um das zu auch noch einzubauen, wird das jetzt zu aufwendig, um einem Anfänger wie mir das hier zu verklickern? Oder schaff ich's mit einem Ansatz auch selbst. Will nicht, dass Du da ewig beschäftigt bist, nur ne Frage.

Grüße
Franz


Bild


Betrifft: Ich hab's! Vielen Dank!
von: Franz W.
Geschrieben am: 25.09.2003 21:40:33

Hallo Nepumuk,

ich hab's geschafft. Ist ja gar nicht so schwer (mit der richtigen Idee :-)))

Muss nur vor dem Exit Sub auch noch Call Sortieren einfügen:


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 3 Then neuer_Eintrag = Target
    Application.ScreenUpdating = False
    ' Bereich der Wirksamkeit
    Set ws = ActiveSheet
    If Range("C65536") = "" Then a = Range("C65536").End(xlUp).Row Else: a = 65536
    b = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
    intCol = 4
    If Not Target.Column = 3 Then Exit Sub
        For iRow = a - 1 To 1 Step -1
            If WorksheetFunction.CountIf(Columns(3), Cells(iRow, 3)) > 1 Then
                Do Until IsEmpty(Cells(iRow, intCol))
                   intCol = intCol + 1
                Loop
                Cells(iRow, intCol) = Date
                Rows(a).ClearContents
                Call Sortieren
                Exit Sub
            ElseIf Target = "" Then
                Exit Sub
            Else
                Cells(a, intCol) = Date
            End If
        Next iRow
Application.ScreenUpdating = True
Call Sortieren
End Sub


Noch mal ganz vielen Dank für Deine Hilfe

Beste Grüße
Franz


 Bild

Beiträge aus den Excel-Beispielen zum Thema " Markieren nach Sortieren"