Anzeige
Archiv - Navigation
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro gleicht Dateien mit Musterdatei ab

Makro gleicht Dateien mit Musterdatei ab
18.02.2019 19:23:41
Sven
Hallo zusammen,
ich habe eine Musterdatei, welche in Zeile 1 Namen stehen hat. Diese reichen von Zelle A1 bis Zelle A101.
Nun habe ich ca. 1000 Dateien, die ich vor dem bearbeiten trennen möchte.
Dafür sollte das Makro die 1000 Dateien, welche alle in einem Ordner liegen, öffnen, und schauen, ob die geöffnete Datei wie die Vorlage aufgebaut ist, also ob Zelle A1 bis A101 identisch sind.
Wenn dies zutrifft wird die geöffnete Datei in den Ordner A verschoben. Andernfalls, wenn keine Übereinstimmung vorliegt in Ordner B.
Kann mir jemand hier weiterhelfen, wie ich das am besten umsetze?
Vielen Dank vorab!
Gruß

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA
19.02.2019 09:28:53
Fennek
Hallo,
als Sängerin finde ich Pink gut, als X-poster etwas weniger.

Const Ziel_A As String = "c:\temp\"
Const Ziel_B As String = "c:\temp\"
Sub F_en()
'diese Datei im Ordner der 1000 xlsx
Dim WB As Workbook
Dim Bo As Boolean
With ThisWorkbook
Ar = .Sheets(1).Range("A1:A101")
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.getFolder(.Path)
For Each f In fld.Files
If fso.getExtensionName(f) = "xlsx" Then
If f.Name = "Sven Test.xlsx" Then
Set WB = GetObject(f)
Br = WB.Sheets(1).Range("A1:A101")
Bo = True
For i = LBound(Ar) To UBound(Ar)
If Ar(i, 1)  Br(i, 1) Then Bo = False
Next i
WB.Close 0
If Bo Then
fso.movefile f, Ziel_A
Else
fso.movefile f, Ziel_B
End If
Application.StatusBar = f.Name
End If
End If
Next f
End With
Set fso = Nothing
Beep
End Sub
mfg
Anzeige
AW: Makro gleicht Dateien mit Musterdatei ab
20.02.2019 18:47:39
Sven
Hallo Fennek,
vielen Dank Dir für Deine Antwort und deine Bemühungen!
Ich habe nun einen Ordner erstellt, in dem ich das Makro testen wollte.
In diesem Ordner habe ich nun den Ordner A und Ordner B sowie zwei xslx Dateien. Wobei die "Richtig" die erste Zeile wie die Musterdatei hat und "Falsch" nicht.
Wenn ich das Makro durchlaufen lasse, erhalte ich jedoch eine Fehlermeldung "Datei existiert bereits" und der Code bleibt bei "fso.movefile f, Ziel_A" stehen.
Kannst Du mir sagen, was ich falsch mache?
Vielen Dank vorab!
Gruß
Userbild
Anzeige
AW: Pfad mit backslash
20.02.2019 22:56:33
Fennek
Hallo,
in meiner Vorlage waren die Pfade "Ziel_A" und "Ziel_B" mit einem backslash "\" abgeschlossen.
mfg
AW: Pfad mit backslash
21.02.2019 16:13:25
Sven
Hallo Fennek,
danke für Deine Antwort! Ich habe die Slashs ergänzt. Das Makro sortiert nun die Datei "Sven Test" in Ordner A, da diese die richtigen Werte in Zeile 1 hat. Jedoch sucht das Makro ausschließlich nach der Datei "Sven Test". Die 1000 Dateien heißen nicht alle gleich. Was müsste ich ändern, damit das Makro jede Excel Datei, unabhängig von dem Namen durchsucht?
Ich habe nochmal einen Screenshot angehängt, da das Makro stehen bleibt, sobald die eine Datei wegsortiert ist.
Viele Grüße und Danke vorab!
Userbild
Anzeige
AW: alle xlsx des Ordners?
21.02.2019 16:25:35
Fennek
falls ja, lösche die Zeile

if f.name = "Sven Test.xlsx"
und das dazu gehörende
end if
Diese Zeilen brauchte ich, da recht viele xlsx in meinem Ordner standen.
Gegebenfalls braucht du eine andere Einschränkung.
AW: alle xlsx des Ordners?
22.02.2019 18:24:14
Sven
Hallo Fennek,
ich habe das Makro nun entsprechend angepasst. Danke für Deine Hilfe! Sehr hilfreich!
Anbei für andere die vielleicht dasselbe Problem haben den modifizierten Code.
Gruß
Const Ziel_A As String = "C:\Users\I015399\Desktop\Neuer Ordner\Ziel_A\"
Const Ziel_B As String = "C:\Users\I015399\Desktop\Neuer Ordner\Ziel_B\"
Sub F_en()
'diese Datei im Ordner der 1000 xlsx
Dim WB As Workbook
Dim Bo As Boolean
With ThisWorkbook
Ar = .Sheets(1).Range("A1:CW1")
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.getFolder(.Path)
For Each f In fld.Files
If fso.getExtensionName(f) = "xlsx" Then
Set WB = GetObject(f)
Br = WB.Sheets(1).Range("A1:CW1")
Bo = True
For i = 1 To 101
If Ar(1, i)  Br(1, i) Then Bo = False
Next i
WB.Close 0
If Bo Then
fso.movefile f, Ziel_A
Else
fso.movefile f, Ziel_B
End If
End If
Next f
End With
Set fso = Nothing
Beep
End Sub

Anzeige
AW: Pfad mit backslash
22.02.2019 14:01:41
Sven
Hallo Fennek,
danke für Deine Antwort! Ich habe die Slashs ergänzt. Das Makro sortiert nun die Datei "Sven Test" in Ordner A, da diese die richtigen Werte in Zeile 1 hat. Jedoch sucht das Makro ausschließlich nach der Datei "Sven Test". Die 1000 Dateien heißen nicht alle gleich. Was müsste ich ändern, damit das Makro jede Excel Datei, unabhängig von dem Namen durchsucht?
Ich habe nochmal einen Screenshot angehängt, da das Makro stehen bleibt, sobald die eine Datei wegsortiert ist.
Viele Grüße und Danke vorab!
Userbild
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige