Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Jüngstes Datum in Textstring ausgeben

Jüngstes Datum in Textstring ausgeben
25.08.2008 18:19:00
Markus
Hallo zusammen,
nachdem meine Netzrecherchen nicht zum Ziel führten, anbei mein erster Beitrag in Form einer Frage...
Zum Hintergrund: Für meine Diplomarbeit hab ich ein Makro geschrieben, welches die Pressemitteilungen (ca. 3000) der Firmen einer Industrie aufbereitet. Hierbei bereinigt es diese um die Firmen-spezifischen Layoutelemente der heruntergeladenen HTML-Seiten und listet die bereinigten Pressetexte säuberlich in Excel auf.
Nun bräuchte ich eine Function, an die ich einen Datenstring übergeben kann (dieser enthält den bereinigten Pressemitteilungstext), welche mir dann das im Datenstring enthaltene jüngste Datum ausgibt. Die Anforderung des jüngsten Datums folgt aus der Besonderheit, dass zukunftsgerichtete Pressetexte häufig mehrere Daten enthalten, ich jedoch am Datum der Pressemitteilung (i.e., das jüngste Datum) interessiert bin. Die Ausgabe der Funktion sollte dann möglichst im Datentyp date erfolgen.
Da die Firmen aus den unterschiedlichsten Ländern stammen, wechseln die Notationen für das Datum zwischen den einzelnen Datenstrings. Denkbar sind v.a.:
Datetype1 = "##.##.####" 'dd.mm.yyyy oder mm.dd.yyyy
Datetype2 = "##.##.##" 'dd.mm.yy oder mm.dd.yy
Datetype3 = "##/##/####" 'dd/mm/yyyy oder mm/dd/yyyy
Datetype4 = "##/##/##" 'dd/mm/yy oder mm/dd/yy
Ausformulierte Monatsangaben werde ich manuell eintragen müssen.
Mein Lösungsansatz geht dahin, nach den wildcard-strings zu suchen, jedoch scheitere ich daran das jünste Datum im Textstring zu identifizieren und nur dieses auszugeben.
Besten Dank für jegliche Hilfe oder Anregung!
Mit vielen Grüssen,
Markus

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Jüngstes Datum in Textstring
25.08.2008 18:38:08
Erich
Hi Markus,
so ist die Aufgabe nicht lösbar.
Wie soll VBA das jüngste Datum ermitteln, wenn nicht klar ist, ob 02.03.08 bzw. 02/03/08
der 2. März oder der 3. Februar ist? (Beide Formate - MM.DD.YY und DD.MM.YY - sind möglich.)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Jüngstes Datum in Textstring
25.08.2008 18:48:01
Markus
Hallo Erich,
ja, das stimmt. Ich hätte an folgende Lösung gedacht: Im Falle 03/29/2007 wäre die Lösung eindeutig, sobald sie zweideutig ist, würde eine beliebige Lösung gesetzt werden (i.e., Standardfall) und der Eintrag mit einer anderen Variable geflagt werden. Diese würde ich nutzen, den Datensatz hervorzuheben und ihn mir dann manuell anschauen und entscheiden.
Hintergrund des Problem ist, dass ich aufgrund der großen Anzahl an Datensätzen, soviel wie möglich automatisieren muss.
VG, Markus
Anzeige
AW: Jüngstes Datum in Textstring
25.08.2008 19:42:13
Erich
Hi Markus,
da werden viele unklare Daten bleiben - alle mit einem Tag Hier ein paar Beispiele:
 ABC
1sdsf12.03.08df03.12.08dgd01.29.08dsfg03.12.2008unklar
2sdsf12.03.08df03.12.08dgd12.29.08dsfg29.12.2008ok
3sdsf12.03.08df13.12.08dgd01.08.08dsfg13.12.2008ok
4sdsf12.03.08df31.12.2008dgd12.29.08dsfg31.12.2008ok
5sdsf12.03.08df03.12.08dgd01.29.08dsfg06.05.0905.06.2009unklar
6df30.12.08dgd01.29.08dsfg05.06.0905.06.2009unklar
7df03.12.08dgd07.29.09dsfg05.06.0929.07.2009ok
8arwerkein Datum 

Und der Code dazu:

Option Explicit
Sub tst()
Dim datD As Date, bolE As Boolean, zz As Long
For zz = 1 To Cells(Rows.Count, 1).End(xlUp).Row
MaxDatum Cells(zz, 1), datD, bolE
If datD > 0 Then
Cells(zz, 2) = datD
Cells(zz, 3) = IIf(bolE, "ok", "unklar")
Else
Cells(zz, 2) = "kein Datum"
End If
Next zz
End Sub
Sub MaxDatum(ByVal strT As String, datM As Date, bolU As Boolean)
Dim ii As Integer, datT As Date, datZ As Date
datM = 0
For ii = 1 To Len(strT) - 7
If IsDate(Mid(strT, ii, 10)) Then
datT = CDate(Mid(strT, ii, 10))
ElseIf IsDate(Mid(strT, ii, 8)) Then
datT = CDate(Mid(strT, ii, 8))
End If
If Day(datT)  datM Or datZ > datM Then
datM = Application.Max(datT, datZ)
bolU = False
End If
Else
datZ = 0
If datT > datM Then
datM = datT
bolU = True
End If
End If
Next ii
End Sub

Dabei habe ich mich weniger nach deinen Formatvorgaben gerichtet, sondern einfach IsDate() genutzt.
Optimal ist das sicher noch nicht, aber vielleicht hilfts dir schon weiter.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Jüngstes Datum in Textstring
25.08.2008 20:01:17
Markus
Hi Erich,
Dank Dir! Ich werds einbetten und geb Dir dann in kürze (~1h) ein detailliertes Feedback.
Bis bald, Markus
AW: Jüngstes Datum in Textstring
25.08.2008 20:26:00
Markus
Hi Erich,
danke, es funktioniert (fast perfekt) mit meinen Datensätzen. Und sehr performant. Ich bin mit der Alternative zur function glücklich, sie ließt auch die angelsächsische Notation ein.
Eine Kleinigkeit nur noch, falls Du noch online sein solltest. Mit jüngstem Datum meinte ich das Min-Datum, da die anderen Daten neben dem Publikationsdatum alle in der Zukunft liegen... Der naive Austausch von "max" durch "min" hat nicht zum erwarteten Ergebnis geführt, dient nur der Ordnung von Monat und Tag, oder?
Nochmals Danke!
Viele Grüsse, Markus
Anzeige
AW: Frühestes Datum in Textstring
25.08.2008 21:13:32
Erich
Hi Markus,
na ja, wann ist ein Datum jünger als ein anderes?
Meine Interpretation "wenn es später 'geboren' ist") hat es nicht getroffen... :-)
Probier mal das Ganze mit "Min":

Option Explicit
Sub tst()
Dim datD As Date, bolE As Boolean, zz As Long
For zz = 1 To Cells(Rows.Count, 1).End(xlUp).Row
MinDatum Cells(zz, 1), datD, bolE
If datD > 0 Then
Cells(zz, 2) = datD
Cells(zz, 3) = IIf(bolE, "ok", "unklar")
Else
Cells(zz, 2) = "kein Datum"
End If
Next zz
End Sub
Sub MinDatum(ByVal strT As String, datM As Date, bolU As Boolean)
Dim ii As Integer, datT As Date
datM = CDate("31.12.9999")
For ii = 1 To Len(strT) - 7
If IsDate(Mid(strT, ii, 10)) Then
datT = CDate(Mid(strT, ii, 10))
ElseIf IsDate(Mid(strT, ii, 8)) Then
datT = CDate(Mid(strT, ii, 8))
End If
If datT > 0 Then
If Day(datT) > 13 Then
If datT  0 Then
datT = Application.Min(datT, DateSerial(Year(datT), Day(datT), Month(datT)))
If datT 

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Frühestes Datum in Textstring
25.08.2008 22:57:46
Markus
Hi Erich,
(entschuldige die späte Rückmeldung!)
danke für die Anpassung. Jedoch kommen jetzt bei mir zum Teil willkürliche Ergebnisse raus...
Ein beispielhafter Auszug mit den Ergebnissen aus dem neuen Makro:
https://www.herber.de/bbs/user/54907.xlsx
VG, Markus
AW: Frühestes Datum in Textstring
25.08.2008 23:12:00
Daniel
Hi
das Dateiformat ist ein bisschen ungeschickt, weil hier noch nicht alle Excel 2007 haben, daher lieber die Datei ins alte Format konvertieren.
btw. sind die Länder, aus denen die einzelnen Artikel stammen bekannt?
dann könnte man u.U. über eine Ländertabelle das verwendete Datumsformat erstellen und so diesen Teil zumindest vereinfachen.
Gruß, Daniel
Anzeige
AW: Frühestes Datum in Textstring
25.08.2008 23:29:10
Markus
Hallo zusammen,
tut mir leid, hatte nicht daran gedacht:
Anbei im 2003er Format: https://www.herber.de/bbs/user/54908.xls
Prinzipiell ja, wobei eine binäre Unterscheidung reichen würde. D.h. ich könnte vor Spalte B eine Spalte einfügen und sagen wir 0 für den (europäischen) Standardcase und 1 für das angesächsische System mit mm/dd/yy oder mm/dd/yyyy setzen. Noch sind die finalen Länder/Firmen nicht fix, d.h. ich würde die Steuerung über 0 und 1 bevorzugen, keine Ländertabelle.
Danke und VG, Markus
AW: Frühestes Datum in Textstring
25.08.2008 23:38:00
Markus
Die Überprüfung, ob das Datum eindeutig ist, könnte man dann dazu umfunktionieren, ob es das einzige Datum im Text war und somit definitiv dem Publikationsdatum entspricht. Unklar würde dann dafür stehen, dass mehrere Daten im Text enthalten waren und das gesetzte min-Datum nur vermutlich das Publikationsdatum ist (was normalerweise richtig sein sollte).
Erich, entschuldigen die ex-post Funktionsänderung. Die "binäre Ländersteuerung", welche ich über die Länderattribute miteinfliessen lassen werde, war eine übersehene Möglichkeit...
(zur letzteren: Manche intl. Konzerne halten sich auch nicht an ihre Länderkonvention, d.h. ich werde das manuell pro Firma einmal festlegen)
Anzeige
AW: Frühestes Datum in Textstring
26.08.2008 00:30:00
Daniel
Hi
wenn du das verwendete Datumformat schon vorab bestimmen kannst, dann kannst du vielleicht folgede UDF verwenden, um das kleinste/Grösste Datum zu finden:

Public Function DatumFinder(Txt As String, DatumFormat As Byte, DatumArt As Byte) As Date
'DatumFormat:   0 - DD.MM.YYYY
'               1 - MM/DD/YYYY
'DatumArt:      0 - kleinstes / Ältestes Datum
'               1 - grösstest / jüngtest Datum
Dim TK As String
Dim p1 As Long
Dim Erg As Date
Dim ZwErg As Date
Dim Tag As Integer, Monat As Integer, Jahr As Integer
Dim T1 As String, T2() As String
Select Case DatumFormat
Case 0
TK = "."
Tag = 0
Monat = 1
Jahr = 2
Case 1
TK = "/"
Tag = 1
Monat = 0
Jahr = 2
End Select
Do
p1 = InStr(p1 + 1, Txt, TK)
If p1 = 0 Then Exit Do
If Mid$(Txt, p1 + 3, 1) = TK Then
T1 = Mid$(Txt, p1 - 2, 10)
T2 = Split(T1, TK)
If Not IsNumeric(T2(2)) Then T2(2) = Left(T2(2), 2) '--- Prüfung, ob Jahreszahl u.U 2- _
Stellig
ZwErg = DateSerial(T2(Jahr), T2(Monat), T2(Tag))
If IsNumeric(T2(0)) Then
If IsNumeric(T2(1)) Then
If IsNumeric(T2(2)) Then
Select Case DatumArt
Case 0
If Erg = 0 Then
Erg = ZwErg
Else
If ZwErg  Erg Then Erg = ZwErg
End If
End Select
End If
End If
End If
p1 = p1 + 3
End If
Loop
DatumFinder = Erg
End Function


1. Parameter: der Text
2. Parameter: das verwendete Datumsformat (0 für europäisch, 1 für amerikanisch)
3. Parameter: suchart: (0 kleinsteset Datum, 1 grösstest Datum)
Funktionsprinzip ist so, daß der Text daraufhin durchsucht wird, ob zwei Datumstrennzeichen im passenden Abstand (3 Zeichen) aufeinander folgen. Wird so eine Textpassage gefunden, wird sie als Datum verwendet und versucht zu berechnen
Gruß, Daniel

Anzeige
AW: Frühestes Datum in Textstring
26.08.2008 08:29:00
Markus
Hallo Daniel,
besten Dank schonmal. Ich melde mich nochmals ausführlich nach dem Test.
Eine Veränderung muss ich vornehmen. Die Funktion soll eigentständig alle Typen (inkl. denen mit der zweistelligen Schreibweise für das Jahr) fassen, d.h. über den Datensatz gesteuert werden, wobei ich eine Steuerungsvariable mit in den Datensatz aufnehmen kann.
Auch möchte ich noch den Hinweisflag hinzufügen, wenn mehrere Daten im Textstring vorkommen.
Bis bald! VG, Markus
AW: Frühestes Datum in Textstring
26.08.2008 08:33:14
Markus
die Prüfung, ob das Jahr zweistellig ist, ist doch enthalten... thx
AW: Frühestes Datum in Textstring
26.08.2008 09:20:00
Markus
Hi Daniel,
ich hab die Funktion in mein Gesamtmakro eingebettet und mit einem variantenreichen Sample an Datensätzen getestet. So wie es aussieht, funktioniert sie sehr zuverlässig. Auch die Markierungsvariable tut ihren Dienst.
Besten Dank soweit an alle Helfer (insb. auch Erich)!
VG, Markus
Anzeige
AW: Frühestes Datum in Textstring
26.08.2008 11:03:13
Erich
Hi Markus,
hier noch eine Variante, bei der die TMJ- bzw. MTJ-Reihenfolge vorgegeben werden kann.
Wenn ein Datum aber nur in einer Reihenfolge sinnvoll sein, die der vorgegebenen widerspricht,
wird das Datum aus der sinnvollen Reihenfolge ausgegeben und die Änderung im letzten Parameter _ bekannt gegeben.

Option Explicit
Sub tst()
Dim datD As Date, bolE As Boolean, zz As Long, bolN As Boolean
For zz = 2 To Cells(Rows.Count, 1).End(xlUp).Row
bolN = False
MinDatum Cells(zz, 1), False, datD, bolN
If datD > 0 Then
Cells(zz, 2) = datD
If bolN Then Cells(zz, 2).Interior.ColorIndex = 3
Else
Cells(zz, 2) = "kein Datum"
End If
bolN = False
MinDatum Cells(zz, 1), True, datD, bolN
If datD > 0 Then
Cells(zz, 3) = datD
If bolN Then Cells(zz, 3).Interior.ColorIndex = 3
Else
Cells(zz, 3) = "kein Datum"
End If
Next zz
End Sub
Sub MinDatum(ByVal strT As String, ByVal bolAm As Boolean, datR As Date, bolF As Boolean)
Dim ii As Integer, intT As Integer, TT, datT As Date, bolZw As Boolean
datR = CDate("31.12.9999")
For ii = 1 To Len(strT) - 7
If Mid(strT, ii, 10) Like "##.##.####" Then
intT = 10
ElseIf Mid(strT, ii, 10) Like "##/##/####" Then
intT = 10
ElseIf Mid(strT, ii, 8) Like "##.##.##" Then
intT = 8
ElseIf Mid(strT, ii, 8) Like "##/##/##" Then
intT = 8
Else
intT = 0
End If
If intT > 0 Then
TT = Split(Mid(strT, ii, intT), Mid(strT, ii + 2, 1))
If TT(0) > 12 And bolAm Then bolZw = True:      bolAm = False
If TT(1) > 12 And Not bolAm Then bolZw = True:  bolAm = True
datT = DateSerial(TT(2), TT(1 + bolAm), TT(-bolAm))
If datT 

Die Rückgaben, bei denen DE bzw. US falsch vorgegeben sind, werden rot eingefärbt.
Und hier die Mappe mit ein paar Beispielen: https://www.herber.de/bbs/user/54917.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Frühestes Datum in Textstring
26.08.2008 13:35:34
Markus
Hallo Erich,
danke! Jetzt bin ich gerüstet fürs grosse Sample (vrmtl. wächst es auf über 10'000 NewsItems - bin am Massendownload). Werde dann sehen, welche Variante das Datenpaket besser schluckt. Evtl. melde ich mich nochmal, falls noch Komplikationen auftreten sollten... Mein Projekt hält zudem noch ein paar andere Herausforderungen bereit ;-)
D.h. ich bedanke mich voerst, glaube jedoch, dass wir uns nochmals hören werden.
Mit besten Grüssen,
Markus

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige