Änderungsdatum und gleiche Dateigrösse behalten
16.11.2023 10:27:07
marcus
ich habe in einer Tabelle Dateien aus einen verzeichnis eingesesen.
Danach soll in der Spalte D Änderungsdatum die gleich sind und Spalte F Dateigrösse die gleich sind in der Liste beibehalten werden, wärend alle anderen aus der Tabelle gelöscht werden sollen.
Dieser Code funktioniert nur bedingt, kann sich das von euch jemand anschauen
Sub Vergleich()
Dim wksListe As Worksheet
Set wksListe = tbl_DuplikateEinlesen ' Name der Tabelle anpassen
Dim lastRow As Long
lastRow = wksListe.Cells(wksListe.Rows.Count, "A").End(xlUp).Row ' Annahme: Daten beginnen in Spalte A
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 2 To lastRow ' Annahme: Die Überschrift ist in Zeile 1, und die Daten beginnen in Zeile 2
Dim fileName As String
Dim modifyDate As Date
Dim fileSize As Double
fileName = wksListe.Cells(i, 1).Value ' Annahme: Dateiname in Spalte A
modifyDate = wksListe.Cells(i, 4).Value ' Annahme: Änderungsdatum in Spalte D
fileSize = wksListe.Cells(i, 6).Value ' Annahme: Dateigröße in Spalte F
' Wenn Datei bereits im Dictionary ist, überprüfe auf Duplikat
If dict.Exists(fileName) Then
' Vergleich des Änderungsdatums und der Dateigröße
If fileSize = dict(fileName)("Size") And CDate(modifyDate) = CDate(dict(fileName)("Date")) Then
' Als behalten markieren, da gleiche Änderungsdatum und Dateigröße
dict(fileName)("Behalten") = True
End If
Else
' Hinzufügen der Datei und der Daten zum Dictionary
Set dict(fileName) = CreateObject("Scripting.Dictionary")
dict(fileName)("Date") = modifyDate
dict(fileName)("Size") = fileSize
dict(fileName)("Behalten") = False
End If
Next i
' Entferne die markierten Duplikate
For i = lastRow To 2 Step -1
If Not dict(wksListe.Cells(i, 1).Value)("Behalten") Then
wksListe.Rows(i).Delete
End If
Next i
End Sub