AW: Warum wird Schleife nur einmal durchlaufen
22.01.2025 20:29:35
Christian
ok, das war wirklich ein Flüchtigkeitsfehler, aber das Problem besteht trotzdem noch.
Falls es hilft, der komplette Code:
Beim Auführen der Einzelschritte springt er sofort von der Zeile For i = 2 To lezteZeileRechnungAJ zur Zeile For Each folderPath In folderPaths. Bis zu dem Punkt, wo das Dictionary gefüllt werden soll, läuft alles nach Plan
Sub DeleteFilesBasedOnNames()
Dim wsRechnung As Worksheet, wsFilme As Worksheet, wsLeute As Worksheet
Dim searchText As Variant
Dim folderPaths As Variant
Dim folderPath As Variant
Dim file As Object
Dim fs As Object
Dim dict As Object
Dim i As Long
Dim letzteZeileRechnungAJ
' Bildschirmaktualisierung und Berechnung deaktivieren
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Setzt das Arbeitsblatt und die Ordnerpfade
Set wsRechnung = ThisWorkbook.Sheets("Rechnung")
Set wsLeute = ThisWorkbook.Sheets("Leute")
Set wsFilme = ThisWorkbook.Sheets("Filme")
folderPaths = Array("E:\Videos", "D:\Bilder")
Set fs = CreateObject("Scripting.FileSystemObject")
' Erstelle ein Dictionary, um die Namen und Status aus Spalten AJ und AK zu speichern
Set dict = CreateObject("Scripting.Dictionary")
wsRechnung.ListObjects("Dateinamen").QueryTable.Refresh BackgroundQuery:=False
letzteZeileFilme = wsFilme.Cells(wsFilme.Rows.Count, 2).End(xlUp).Row
letzteZeileLeute = wsLeute.Cells(wsLeute.Rows.Count, 1).End(xlUp).Row
letzteZeileRechnungV = wsRechnung.Cells(wsRechnung.Rows.Count, 22).End(xlUp).Row
letzteZeileRechnungAJ = wsRechnung.Cells(wsRechnung.Rows.Count, 36).End(xlUp).Row
Debug.Print "Letzte Zeile AJ: " & letzteZeileRechnungAJ
wsRechnung.Range("Y2:Y" & letzteZeileRechnungV).FormulaLocal = "=XVERWEIS(W2;Filme!B$2:B$" & letzteZeileFilme & ";Filme!C$2:C$" & letzteZeileFilme & ";"""";0;1)"
wsRechnung.Range("Z2:Z" & letzteZeileRechnungV).FormulaLocal = "=XVERWEIS(W2;Filme!B$2:B$" & letzteZeileFilme & ";Filme!E$2:E$" & letzteZeileFilme & ";"""";0;1)"
wsRechnung.Range("AA2:AA" & letzteZeileRechnungV).FormulaLocal = "=XVERWEIS(X2;Leute!B$2:B$" & letzteZeileLeute & ";Leute!C$2:C$" & letzteZeileLeute & ";"""";0;1)"
wsRechnung.Range("AB2:AB" & letzteZeileRechnungV).FormulaLocal = "=XVERWEIS(X2;Leute!B$2:B$" & letzteZeileLeute & ";Leute!D$2:D$" & letzteZeileLeute & ";"""";0;1)"
wsRechnung.Range("AC2:AC" & letzteZeileRechnungV).FormulaLocal = "=DATEDIF(AB2;Z2;""Y"")"
wsRechnung.Range("AD2:AD" & letzteZeileRechnungV).FormulaLocal = "=DATEDIF(AB2;Z2;""YD"")"
wsRechnung.Range("AE2:AE" & letzteZeileRechnungV).FormulaLocal = "=Z2-AB2"
wsRechnung.Range("AF2:AF" & letzteZeileRechnungV).FormulaLocal = "=""MRS ""&TEXT(AE2;""00000"")&"" ""&WECHSELN(WECHSELN(WECHSELN(WECHSELN(Y2;""?"";"""");"":"";"""");""/"";"""");""*"";"""")&"" (""&TEXT(Z2;""TT.MM.JJJJ"")&"") - ""&AA2&"" (""&TEXT(AB2;""TT.MM.JJJJ"")&"") ""&AC2&""-""&AD2"
wsRechnung.Range("AH2:AH" & letzteZeileRechnungV).FormulaLocal = "=ZÄHLENWENN(AJ$2:AJ$" & letzteZeileRechnungAJ & ";AF2)"
wsRechnung.Range("AK2:AK" & letzteZeileRechnungAJ).FormulaLocal = "=ZÄHLENWENN(AF$2:AF$" & letzteZeileRechnungV & ";AJ2)"
wsRechnung.Range("Y2:AH" & letzteZeileRechnungV).Value2 = wsRechnung.Range("Y2:AH" & letzteZeileRechnungV).Value2
wsRechnung.Range("AK2:AK" & letzteZeileRechnungAJ).Value2 = wsRechnung.Range("AK2:AK" & letzteZeileRechnungAJ).Value2
' Füllt das Dictionary mit den Daten aus Spalte AJ und AK
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To lezteZeileRechnungAJ
If wsRechnung.Cells(i, "AK").Value = 0 Then
dict.Add wsRechnung.Cells(i, "AJ").Value, 0
Debug.Print "Hinzugefügt zum Dictionary: " & wsRechnung.Cells(i, "AJ").Value
End If
Next i
' Durchläuft die beiden Ordner
For Each folderPath In folderPaths
' Durchsucht alle Dateien im Ordner
For Each file In fs.GetFolder(folderPath).Files
' Durchsucht das Dictionary nach übereinstimmenden Dateinamen
For Each searchText In dict.Keys
If LCase(Left(file.Name, Len(searchText))) = LCase(searchText) Then
' Löscht die Datei
'On Error Resume Next ' Falls Datei gerade verwendet wird, überspringen
fs.DeleteFile file.Path
'On Error GoTo 0 ' Fehlerbehandlung zurücksetzen
Debug.Print "Datei gelöscht: " & file.Path ' Gibt den gelöschten Dateinamen im Direktfenster aus
End If
Next searchText
Next file
Next folderPath
' Wiederherstellung der ursprünglichen Einstellungen
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Dateien wurden geprüft und gelöscht, falls zutreffend.", vbInformation
End Sub
