kleineren Wert in Spalte suchen und markieren

Peter · 2016-11-11T18:08:35+00:00

Hallo Ihr Excelspezialisten, benötige wieder einmal dringend Eure Hilfe. Ich habe in einer Spalte (A) die geöffneten Dateien aufgelistet. Alle diese Dateien lauten wie etwa diese: KontoVers102016_testFörder_Laufend_ab 01.01.2015.xlsm KontoVers102016_testFörder_Laufend_ab 01.01.2017.xlsm KontoVers102016_testFörder_Laufend_ab 01.01.2018.xlsm Es soll nun per Makro die markiert werden, die um ein Jahr niedriger ist, als die mit dem höchsten Datum (2018). Besten Dank für Eure Hilfe. Gruss Peter

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

Hi Zusammen,
hab auch noch eine Lösung mit Array:
Sub EinJahrNiedrigerMarkieren()

Dim VarDat()
Dim lngZeileMax As Long
Dim intZ As Long
Dim z As Long
Dim VarDatLast As Long
With Tabelle1
.Range("A:A").Interior.ColorIndex = xlColorIndexNone
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
intZ = 0
For lngzeile = 1 To lngZeileMax
ReDim Preserve VarDat(intZ)
VarDat(intZ) = Split(.Range("A" & lngzeile), " ")(1)
intZ = intZ + 1
Next lngzeile
lngzeile = 0
For i = LBound(VarDat) To UBound(VarDat)
VarDat(i) = Left(VarDat(i), Len(VarDat(i)) - 5)
Next i
i = 0
z = 1
VarDatLast = UBound(VarDat)
For i = LBound(VarDat) To UBound(VarDat)
If DateDiff("yyyy", VarDat(i), VarDat(VarDatLast)) = 1 Then
.Cells(z, 1).Interior.ColorIndex = 4
End If
z = z + 1
Next i
End With
End Sub

VG Anton

kleineren Wert in Spalte suchen und markieren

Forumthread: kleineren Wert in Spalte suchen und markieren

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

kleineren Wert in Spalte suchen und markieren

Forumthread: kleineren Wert in Spalte suchen und markieren

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread