Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1292to1296
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
Inhaltsverzeichnis

Sortieren nach Tag - Monat - Jahr

Sortieren nach Tag - Monat - Jahr
20.01.2013 12:18:25
Waltraudt
Hallo zusammen im Forum,
bei Programmstart wird überprüft, ob am heutigen Datum Geburtstage anfallen. Bei Klick auf den Button OK wird überprüft, ob in den nächsten 10 Tagen Geburtstage anfallen.
So weit, so gut. Das klappt.
Aber wie kann ich erreichen, das die Geburtstage sortiert nach Tag - Monat - Jahr angezeigt werden?
Wer kann meinen angehängten Code-Schnipsel dahingehend ändern (ich kann es leider nicht, der Schnipsel wurde von einem Bekannten erstellt!)?
LG Waltraudt
Private Sub Workbook_Open()
Sheets("Geburtstage").Select
Range("c4").Select
Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer
Const iNn As Integer = 3   ' Spalte C - Nachnamen
Const iVn As Integer = 5   ' Spalte E - Vornamen
Const iG As Integer = 8    ' Spalte H - Geburtstage
sMldg1 = "Geburtstage heute:" & vbLf
lR = 4
Do Until IsEmpty(Cells(lR, iVn))
iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
If iDiff  "" Then
MsgBox "Geburtstage in den nächsten 10 Tagen:" & vbLf & sMldg2, , " GEBURTSTAGS-INFO... _
_
Else
MsgBox "Keine Geburtstage in den nächsten 10 Tagen!", , " GEBURTSTAGS-INFO..."
End If
End If
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren nach Tag - Monat - Jahr
20.01.2013 13:47:11
Waltraudt
Ups...
Mein Fehler - falsch ausgedrückt?!
Die Anzeige und Sortierung erfolgt nicht in einem Tabellenblatt, sondern (siehe Code-Schnipsel) erfolgt in einer MSG-Box und soll eben dort nach den genannten Kriterien sortiert angezeigt werden.
Ich bin für jeden Vorschlag möglichst mit Code-Anpassung dankbar!
LG Waltraudt

Anzeige
AW: Sortieren nach Tag - Monat - Jahr
20.01.2013 15:43:58
Hajo_Zi
Hallo Waltraud,
sortiere es doch in der Tabelle.
Sortieren nach Monat und Tag
das Datum steht in Spalte A
Sortieren tust Du nur nach einer Hilfsspalte; darin steht:
=MONAT(A1)+TAG(A1)/100
und runterkopieren
und
Monat, Tag und Jahr
=MONAT(A1)+TAG(A1)/100+Jahr(A1)/10000
und runterkopieren (Zellformat ist Standard)
Gruß Hajo

OT Danke Hajo, so einfach und - klappt!
20.01.2013 15:48:43
Waltraudt
LG Waltraudt

AW: Sortieren nach Tag - Monat - Jahr
20.01.2013 15:53:34
fcs
Hallo Waltraud,
hier noch eine Lösung mit Sortierung des Meldetextes im Makro.
Gruß
Franz
Private Sub Workbook_Open()
Sheets("Geburtstage").Select
Range("c4").Select
Dim sMldg As String, lR As Long, iDiff As Integer
Dim strGeb() As String, strHeute() As String, datGeb As Date
Dim intI As Integer, intJ As Integer
Const iNn As Integer = 3   ' Spalte C - Nachnamen
Const iVn As Integer = 5   ' Spalte E - Vornamen
Const iG As Integer = 8    ' Spalte H - Geburtstage
lR = 4
intI = 0: intJ = 0
'Geburtstage überprüfen und Information in Datenarrays schreiben
Do Until IsEmpty(Cells(lR, iVn))
datGeb = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG)))
iDiff = datGeb - Date
If iDiff  1 Then
Call Quicksort(Data:=strHeute, links:=1, rechts:=intJ)
End If
If intI > 1 Then
Call Quicksort(Data:=strGeb, links:=1, rechts:=intI)
End If
'Meldetext für heutige Geburtstage
If intJ > 0 Then
sMldg = "Geburtstage heute:" & vbLf
For intJ = 1 To intJ
sMldg = sMldg & vbLf & Mid(strHeute(intJ), 12)
Next
Else
sMldg = "Heute kein Geburtstag!"
End If
If MsgBox(sMldg, vbInformation + vbOKCancel, " GEBURTSTAGS-INFO...") = vbOK Then
'Meldetext für Geburtstage nächste 10 tage
If intI > 0 Then
sMldg = "Geburtstage in den nächsten 10 Tagen:" & vbLf
For intI = 1 To intI
sMldg = sMldg & vbLf & Mid(strGeb(intI), 12)
Next
MsgBox sMldg, vbInformation, " GEBURTSTAGS-INFO..."
Else
MsgBox "Keine Geburtstage in den nächsten 10 Tagen!", vbInformation, _
" GEBURTSTAGS-INFO..."
End If
End If
Erase strGeb, strHeute
End Sub
Public Function Quicksort(Data, links, rechts)
'Sortieren einer einspaltigen Datenliste
'links und rechts geben die Nummern der der Elemente an, die sortiert werden sollen
'normalerweise nimmt man das 1. und letzte Element
Dim Teiler As Long
If rechts > links Then
Teiler = Teile(Data, links, rechts)
Call Quicksort(Data, links, Teiler - 1)
Call Quicksort(Data, Teiler + 1, rechts)
End If
End Function
Private Function Teile(Data, links, rechts)
Dim Index As Long
Dim i As Long
Index = links
For i = links To rechts - 1
If Data(i) 

Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige