AW: kleineren Wert in Spalte suchen und markieren
11.11.2016 22:10:30
fcs
Hallo Peter,
hier eine Variante. dabei wird beim Vergleich der Datums-Texte in den Dateinamen ähnlich verfahren.
LG
Franz
Sub Suche_1_Jahr_aeltere_Datei()
Dim wks As Worksheet, Zeile As Long
Dim strNameJung As String, strNameAlt As String
Dim strTeilJung As String, strTeilAlt As String
Dim DatumJung As Date, DatumAlt As Date, TextDatum As String
Set wks = ActiveSheet 'ActiveWorkbook.Worksheets("Tabelle1")
With wks
'Name derVergleichsdatei aus Zellinhalten ermitteln
strNameJung = .Range("D1").Text & "_" & .Range("E1").Text & "_" & .Range("F1").Text _
& "_ab " & .Range("G1").Text & ".xlsm"
'Dateiname ohne Datum und Erweiterung
strTeilJung = Left(strNameJung, InStrRev(strNameJung, ".") - 11)
TextDatum = Mid(strNameJung, InStrRev(strNameJung, ".") - 10, 10)
If IsDate(TextDatum) Then
DatumJung = CDate(TextDatum)
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
strNameAlt = .Cells(Zeile, 1).Text
'Vergleichsdateiname ohne Datum und Erweiterung
strTeilAlt = Left(strNameAlt, InStrRev(strNameAlt, ".") - 11)
If LCase(strTeilJung) = LCase(strTeilAlt) Then
TextDatum = Mid(strNameAlt, InStrRev(strNameAlt, ".") - 10, 10)
If IsDate(TextDatum) Then
DatumAlt = CDate(TextDatum)
If Day(DatumJung) = Day(DatumAlt) _
And Month(DatumJung) = Month(DatumAlt) _
And Year(DatumJung) - Year(DatumAlt) = 1 Then
.Activate
.Cells(Zeile, 1).Select
Exit For
End If
End If
End If
Next
Else
MsgBox "Dateiname & """ & strNameJung & """ enthält kein gültiges Datum"
End If
End With
End Sub