AW: Spalte [Datum] nach Monat sortieren
18.07.2005 00:21:27
Erich
Hallo Markus,
zeigt die folgende Tabelle einen Teil dessen, was du wolltest ("von heute weg sortiert")?
| A | B | C | D | E | F |
-- | ----------- | ----- | - | ----------- | ----- | -------------- |
1 | Geburt | Name | | Geburt | Name | GebT in Tagen |
2 | 16.06.1944 | a | | 17.07.2005 | k | 0 |
3 | 01.01.1966 | b | | 20.07.2004 | j | 3 |
4 | 15.01.1966 | c | | 01.08.1999 | g | 15 |
5 | 02.05.1977 | d | | 31.12.1977 | e | 167 |
6 | 31.12.1977 | e | | 01.01.1988 | f | 168 |
7 | 01.01.1988 | f | | 01.01.1966 | b | 168 |
8 | 01.08.1999 | g | | 15.01.1966 | c | 182 |
9 | 16.07.2000 | h | | 02.05.1977 | d | 289 |
10 | 20.07.2004 | j | | 16.06.1944 | a | 334 |
11 | 17.07.2005 | k | | 16.07.2000 | h | 364 |
Die Daten in den Spalten A und B wurden eingegeben.
Das folgende Makro berechnet (für max. 200 Zeilen) die Spalten D und E mit den gleichen Daten, aber sortiert nach der Anzahl der Tage zum nächsten Geburtstag (spaßhalber in Spalte F ausgegeben). Die Ergenisse stehen nur für die Demo in den Spalten D und E, sie könnten natürlich auch die Daten in den Spalten A und B überschreiben.Option Explicit
Type zeile
dd As Date
tt As String
nr As Long
End Type
Sub Sort_Geb()
Dim zz&, ii&, jj&
Dim dat(1 To 200) As zeile, zwi As zeile
' Einlesen
zz = 1
While Not IsEmpty(Cells(zz + 1, 1)) And zz < 200
dat(zz).dd = Cells(zz + 1, 1)
dat(zz).tt = Cells(zz + 1, 2)
dat(zz).nr = _
DateSerial(Year(Date), Month(Cells(zz + 1, 1)), Day(Cells(zz + 1, 1))) _
- DateSerial(Year(Date), Month(Date), Day(Date))
' GebTag in diesem Jahr schon vorüber -> nächstes Jahr
If dat(zz).nr < 0 Then _
dat(zz).nr = dat(zz).nr + DateSerial(Year(Date) + 1, 1, 1) _
- DateSerial(Year(Date), 1, 1)
zz = zz + 1
Wend
' Sortierung
For ii = 1 To zz - 2
For jj = ii + 1 To zz - 1
If dat(jj).nr < dat(ii).nr Then
zwi = dat(jj)
dat(jj) = dat(ii)
dat(ii) = zwi
End If
Next jj
Next ii
' Ausgabe
Cells(1, 4) = Cells(1, 1)
Cells(1, 5) = Cells(1, 2)
Cells(1, 6) = "GebT in Tagen"
For ii = 1 To zz - 1
Cells(ii + 1, 4) = dat(ii).dd
Cells(ii + 1, 5) = dat(ii).tt
Cells(ii + 1, 6) = dat(ii).nr
Next ii
End Sub
Soll die Tabelle bei der "umgekehrten Sortierung" aussagen, wie viele Tage seit dem letzten Geburtstag vergangen sind? Das sähe sehr ähnlich aus.
Grüße aus Kamp-Lintfort
Erich