Tabellenkalkulation: Excel: zwei Spalten nach Datum sortieren

Excel: zwei Spalten nach Datum sortieren

(592 Hits)

Hallo in die Runde,

ich habe eine Tabelle, die mich schier wahnsinnig macht ;-) und
hoffe, dass mir jemand dabei behilflich sein kann.

Ich habe eine Tabelle, die grundlegend folgendermaßen aufgebaut
ist:

Name | Geburtsdatum (TT MM YYYY) | Todesdatum (TT MM YYYY)

Nun möchte ich, dass die Tabelle so sortiert ist, dass mir an jedem
Tag des Jahres angezeigt ist, wer geboren und wer gestorben ist,
also was ist zum Beispiel alles am 01.01. passiert, was am 02.01.
und so weiter (Wer ist am 01.01. geboren und dann wer ist am 01.01.
gestorben, dann wer ist am 02.01. geboren und dann wer ist am
02.01. gestorben)
Dabei gibt es noch folgende zwei Hürden:
- Es sind nicht alle Daten für jede Zeile vorhanden, bei manchen
Personen ist das Geburtsdatum nicht bekannt, andere leben
beispielsweise noch. Deswegen kommt eine Pivot-Tabelle nicht in
Frage (das Gruppieren ist nicht möglich), die eigentlich ein gutes
Mittel wäre.
- Die Daten liegen zu einem großen Teil vor 1900, ich musste also
das Add-Ins "xdate" einsetzen.

Hat jemand eine Idee, wie ich das lösen könnte?

Viele Grüße
chriseil

Sub DatumsSuche() Dim Qarr As Variant, Darr As Variant, Marr As Variant Dim ZeilenZähler As Long If ActiveSheet.AutoFilterMode = False Then Qarr = Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) Darr = Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) Marr = Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) For ZeilenZähler = 1 To UBound(Qarr) Darr(ZeilenZähler, 1) = Day(Qarr(ZeilenZähler, 1)) Marr(ZeilenZähler, 1) = Month(Qarr(ZeilenZähler, 1)) Next ZeilenZähler Range(Cells(2, Columns.Count - 1), Cells(UBound(Qarr) + 1, Columns.Count - 1)) = Darr Range(Cells(2, Columns.Count), Cells(UBound(Qarr) + 1, Columns.Count)) = Marr ActiveSheet.Range(Cells(1, Columns.Count - 1), Cells(1, Columns.Count)).AutoFilter ActiveSheet.Cells(1, Columns.Count - 1).AutoFilter Field:=1, Criteria1:=Day(Date) ActiveSheet.Cells(1, Columns.Count).AutoFilter Field:=2, Criteria1:=Month(Date) Else ActiveSheet.Range(Cells(1, Columns.Count - 1), Cells(1, Columns.Count)).AutoFilter Columns(Columns.Count - 1).Clear Columns(Columns.Count).Clear End If End Sub

Function DMDate(Zelle As Range, Modus As Boolean) As Integer Dim DArr As Variant, MArr As Variant If Modus = False Then DArr = Zelle DMDate = Day(DArr) Else MArr = Zelle DMDate = Month(MArr) End If End Function

Sub DatumFilter() Dim DatenDatum As Variant Dim ZeilenIndex As Long If ActiveSheet.AutoFilterMode = False Then Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)).NumberFormat = "dd/mm/yyyy" Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)).HorizontalAlignment = xlRight DatenDatum = Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)) For ZeilenIndex = 1 To UBound(DatenDatum, 1) If Day(Date) = Day(DatenDatum(ZeilenIndex, 1)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 1)) Or Day(Date) = Day(DatenDatum(ZeilenIndex, 2)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 2)) Then Cells(ZeilenIndex + 1, Columns.Count) = True Next ZeilenIndex ActiveSheet.Range(Cells(1, Columns.Count), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, Columns.Count)).AutoFilter Field:=1, Criteria1:=True Else ActiveSheet.Cells(1, Columns.Count).AutoFilter Columns(Columns.Count).Clear End If End Sub

Sub DatumFilter() Dim DatenDatum As Variant, Puffer As Variant Dim ZeilenIndex As Long If ActiveSheet.AutoFilterMode = False Then Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)).NumberFormat = "dd/mm/yyyy" Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)).HorizontalAlignment = xlRight DatenDatum = Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 2)) Puffer = Range(Cells(2, 1), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, 1)) For ZeilenIndex = 1 To UBound(DatenDatum, 1) If Day(Date) = Day(DatenDatum(ZeilenIndex, 1)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 1)) Or Day(Date) = Day(DatenDatum(ZeilenIndex, 2)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 2)) Then Puffer(ZeilenIndex, 1) = True Next ZeilenIndex Range(Cells(2, Columns.Count), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, Columns.Count)) = Puffer ActiveSheet.Range(Cells(1, Columns.Count), Cells(ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row, Columns.Count)).AutoFilter Field:=1, Criteria1:=True Else ActiveSheet.Cells(1, Columns.Count).AutoFilter Columns(Columns.Count).Clear End If End Sub

Hallo chriseil .-)

Datumswerte sind nun Spalte B+C,hatte ich wohl vergessen

Einzufügen
Alt+F11/Projektexplorer/Allgemeines Modul

Gruß Nighty

Sub DatumFilter()
    Dim DatenDatum As Variant, Puffer As Variant
    Dim ZeilenIndex As Long
    If ActiveSheet.AutoFilterMode = False Then
        Range(Cells(2, 2), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, 3)).NumberFormat = "dd/mm/yyyy"
        Range(Cells(2, 2), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, 3)).HorizontalAlignment = xlRight
        DatenDatum = Range(Cells(2, 2), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, 3))
        Puffer = Range(Cells(2, 2), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, 3))
        For ZeilenIndex = 1 To UBound(DatenDatum, 1)
            If Day(Date) = Day(DatenDatum(ZeilenIndex, 1)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 1)) Or Day(Date) = Day(DatenDatum(ZeilenIndex, 2)) And Month(Date) = Month(DatenDatum(ZeilenIndex, 2)) Then Puffer(ZeilenIndex, 1) = True
        Next ZeilenIndex
        Range(Cells(2, Columns.Count), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, Columns.Count)) = Puffer
        ActiveSheet.Range(Cells(1, Columns.Count), Cells(ActiveSheet.Range(Cells(Rows.Count, 2), Cells(Rows.Count, 2)).End(xlUp).Row, Columns.Count)).AutoFilter Field:=1, Criteria1:=True
    Else
        ActiveSheet.Cells(1, Columns.Count).AutoFilter
        Columns(Columns.Count).Clear
    End If
End Sub