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

Änderungsdatum und gleiche Dateigrösse behalten

Forumthread: Änderungsdatum und gleiche Dateigrösse behalten

Änderungsdatum und gleiche Dateigrösse behalten
16.11.2023 10:27:07
marcus
Hallo liebe Forumsmitlieder,

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
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Änderungsdatum und gleiche Dateigrösse behalten gelöst
16.11.2023 11:04:02
marcus
Habe einen anderen ansatz probiert dieser Funktioniert auch, trotzdem Danke!

Sub VergleichDatumGroesse()
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

' Extrahiere den Dateinamen ohne Pfad
fileName = Mid(wksListe.Cells(i, 1).Formula, InStrRev(wksListe.Cells(i, 1).Formula, "\") + 1)
modifyDate = wksListe.Cells(i, 4).Value ' Annahme: Änderungsdatum in Spalte D
fileSize = wksListe.Cells(i, 6).Value ' Annahme: Dateigröße in Spalte F

' Verwende eine Kombination aus Dateiname, Änderungsdatum und Größe als Schlüssel
Dim key As String
key = fileName & "_" & Format(modifyDate, "dd.mm.yyyy hh:mm:ss") & "_" & Format(fileSize, "0.000000")

' Wenn der Schlüssel bereits im Dictionary ist, als behalten markieren
If dict.Exists(key) Then
dict(key) = True
Else
' Hinzufügen des Schlüssels zum Dictionary
dict.Add key, False
End If
Next i

' Entferne die markierten Duplikate
For i = lastRow To 2 Step -1
Dim keyToDelete As String
keyToDelete = Mid(wksListe.Cells(i, 1).Formula, InStrRev(wksListe.Cells(i, 1).Formula, "\") + 1) & "_" & _
Format(wksListe.Cells(i, 4).Value, "dd.mm.yyyy hh:mm:ss") & "_" & _
Format(wksListe.Cells(i, 6).Value, "0.000000")

If dict.Exists(keyToDelete) Then
If Not dict(keyToDelete) Then
wksListe.Rows(i).Delete
End If
End If
Next i
End Sub
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige