Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1348to1352
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

Reihenfolge beim Import von xls Dateien

Reihenfolge beim Import von xls Dateien
06.02.2014 17:08:11
xls
Hallo zusammen,
ich habe ein "Import" Dateiliste erstellt, mit der ich aus einem Ordner aus bis zu 400 einzelne Excel Dateien diverse Daten importiere (zur Auftrags-Analyse).
Das Importieren neuer Dateien funktioniert sehr gut.
Jetzt kommt der nächste Schritt -> geänderte Dateien, d.h. der Dateiname ist derselbe wie vorher, aber innerhalb der Datei in den Feldern gab es Änderungen.
Mittlerweile bin ich soweit, dass ich in der "Import" Dateiliste auch das Änderungsdatum der Dateien ablegen kann (Funktion über allg. Modul)
Das ist mein bisheriger Code zum importieren:
Sub importmodul()
Dim sFile As String, wkb As Workbook, aeRow As Long, lRow As Long, sortLAST As Long, wksDATA  _
As Worksheet, aender As Date
Application.ScreenUpdating = False 'Flackern aus
Const sPfad As String = "mein Pfad"  'anpassen
Set wksDATA = ActiveWorkbook.Sheets("DATA") 'anpassen
sFile = Dir(sPfad & "*.xls*")
aeRow = 5
Do While sFile  ""
aender = Aenderungsdatum(sPfad & sFile)
oldaender = wksDATA.Range("data_aenderung").Cells(aeRow)
MsgBox (oldaender & " " & aender)
If WorksheetFunction.CountIf(wksDATA.Columns(1), sFile) = 0 Then
'Datei wurde noch nicht importiert
With wksDATA
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1) = sFile 'Datei merken
.Hyperlinks.Add .Cells(lRow, 1), sPfad & sFile
.Hyperlinks.Add .Cells(lRow, 2), Cells(lRow, 2), TextToDisplay:="select"
.Range("data_aenderung").Cells(lRow) = Aenderungsdatum(sPfad & sFile)
End With
Set wkb = Workbooks.Open(sPfad & sFile)
With wkb.Sheets(1)
'MsgBox (lRow)
'Daten aus Auftrag Blatt 1 übertragen
wksDATA.Range("data_datum").Cells(lRow) = .Range("datumheute") 'Datum
wksDATA.Range("data_werbeform").Cells(lRow) = .Range("Zwerbeform") 'Werbeform
wksDATA.Range("data_kunde").Cells(lRow) = .Range("kunde") 'Kunde
wksDATA.Range("data_titel").Cells(lRow) = .Range("titel") 'Titel
wksDATA.Range("data_auftragsnummer").Cells(lRow) = .Range("auftragsnummer") ' _
Auftragsnummer
wksDATA.Range("data_berater").Cells(lRow) = .Range("berater") 'Mediaberater
wksDATA.Range("data_basis").Cells(lRow) = .Range("Zbasisprodkosten") 'Basis  _
Budget
wksDATA.Range("data_vkonair").Cells(lRow) = .Range("Zformelsummeonair") 'VK On  _
Air
wksDATA.Range("data_vkonline").Cells(lRow) = .Range("Zformelsummeonline") 'VK  _
Online
wksDATA.Range("data_mediawert").Cells(lRow) = .Range("Zformelsummemedia") ' _
Media Budget
wksDATA.Range("data_motive").Cells(lRow) = WorksheetFunction.Sum(.Range(" _
zmotive").Value)  'Motive
wksDATA.Range("data_wm1").Cells(lRow) = .Range("onairauswahl1")  'Werbemittel 1
wksDATA.Range("data_wm2").Cells(lRow) = .Range("onairauswahl2")  'Werbemittel 2
wksDATA.Range("data_wm3").Cells(lRow) = .Range("onairauswahl3")  'Werbemittel 3
wksDATA.Range("data_wm4").Cells(lRow) = .Range("onairauswahl4")  'Werbemittel 4
wksDATA.Range("data_wm5").Cells(lRow) = .Range("onairauswahl5")  'Werbemittel 5
wksDATA.Range("data_wm6").Cells(lRow) = .Range("onairauswahl6")  'Werbemittel 6
wksDATA.Range("data_wm7").Cells(lRow) = .Range("onairauswahl7")  'Werbemittel 7
wksDATA.Range("data_wm8").Cells(lRow) = .Range("onairauswahl8")  'Werbemittel 8
wksDATA.Range("data_gebiet1").Cells(lRow) = .Range("gebiet1") 'Gebiet 1
wksDATA.Range("data_gebiet2").Cells(lRow) = .Range("gebiet2") 'Gebiet 2
wksDATA.Range("data_gebiet3").Cells(lRow) = .Range("gebiet3") 'Gebiet 3
wksDATA.Range("data_gebiet4").Cells(lRow) = .Range("gebiet4") 'Gebiet 4
wksDATA.Range("data_gebiet5").Cells(lRow) = .Range("gebiet5") 'Gebiet 5
wksDATA.Range("data_gebiet6").Cells(lRow) = .Range("gebiet6") 'Gebiet 6
wksDATA.Range("data_gebiet7").Cells(lRow) = .Range("gebiet7") 'Gebiet 7
wksDATA.Range("data_gebiet8").Cells(lRow) = .Range("gebiet8") 'Gebiet 8
wksDATA.Range("data_ow1").Cells(lRow) = .Range("onlineauswahl1") ' Online  _
Werbemittel 1
wksDATA.Range("data_ow2").Cells(lRow) = .Range("onlineauswahl2") ' Online  _
Werbemittel 2
wksDATA.Range("data_ow3").Cells(lRow) = .Range("onlineauswahl3") ' Online  _
Werbemittel 3
wksDATA.Range("data_ow4").Cells(lRow) = .Range("onlineauswahl4") ' Online  _
Werbemittel 4
wksDATA.Range("data_ow5").Cells(lRow) = .Range("onlineauswahl5") ' Online  _
Werbemittel 5
wksDATA.Range("data_ow6").Cells(lRow) = .Range("onlineauswahl6") ' Online  _
Werbemittel 6
wksDATA.Range("data_ow7").Cells(lRow) = .Range("onlineauswahl7") ' Online  _
Werbemittel 7
wksDATA.Range("data_hp1").Cells(lRow) = .Range("homepage1") ' Homepage 1
wksDATA.Range("data_hp2").Cells(lRow) = .Range("homepage2") ' Homepage 2
wksDATA.Range("data_hp3").Cells(lRow) = .Range("homepage3") ' Homepage 3
wksDATA.Range("data_hp4").Cells(lRow) = .Range("homepage4") ' Homepage 4
wksDATA.Range("data_hp5").Cells(lRow) = .Range("homepage5") ' Homepage 5
wksDATA.Range("data_hp6").Cells(lRow) = .Range("homepage6") ' Homepage 6
wksDATA.Range("data_hp7").Cells(lRow) = .Range("homepage7") ' Homepage 7
End With
wkb.Close False
End If
sFile = Dir
aeRow = aeRow + 1
Loop
'sortLAST = wksDATA.Cells(Rows.Count, 2).End(xlUp).Row
'wksDATA.Range("A5:AR" & sortLAST).Sort _
'Key1:=Range("C5"), _
'Order1:=xlDescending
Application.ScreenUpdating = True
End Sub

Meine Fragen:
Wie gehe ich am besten vor um geänderte Dateien zu importieren? Dabei müsste die "alte Datei" in der Liste ja ersetzt werden...
Mein bisheriger Ansatz lief über das (im Code auskommentierte) Sortieren nach dem Änderungsdatum, um dann beim Import auch dann Dateien zu importieren, wenn das bisherige Änderungsdatum sich vom Änderungsdatum im Explorer unterscheidet. Da bei Workbooks.Open aber anscheinend immer nach Name sortiert die Dateien geöffnet werden, klappte das nicht...
Villeicht gibt es ja auch einen ganz anderen Ansatz um eine solche Liste mit Änderungen an Dateien zu behandeln.
Freue mich auf Vorschläge udn Hilfe,
Vielen Dank und beste Grüße,
Stefan

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Reihenfolge beim Import von xls Dateien
06.02.2014 20:04:50
xls
Mal ohne Codebeispiel bzw. nur das Grundgerüst.
Du nimmst folgenden Code um das Datum zu ersetzen, wenn der Dateiname schon existiert bzw. kannst dann auch abfragen ob sich das überhaupt geändert hat und dann direkt zur nächsten Datei wechseln. (Die Uhrzeit wird ja mit angegeben)
Das steht nur als "sub", damit es richtig formatiert ist.
Sub suchen()
With Worksheets(1).Range("a1:a500") 'wo wird gesucht
Set c = .Find("Dateiname", LookIn:=xlValues) 'was wird gesucht
If Not c Is Nothing Then
' wurde gefunden
Else
' wurde nicht gefunden
End If
End With
End Sub

Anzeige
AW: Reihenfolge beim Import von xls Dateien
07.02.2014 13:00:38
xls
Hi Franc,
vielen Dank schonmal, schaue ich mir an. Auf den ersten Blick weiss ich zwar noch nicht, wo ich das einbaue bzw. wie ich das Durchsuchen damit ersetze. Ist das ein besserer Ersatz für
If WorksheetFunction.CountIf(wksDATA.Columns(1), sFile) = 0 Then
in meinem Code oben?
Die erforderlichen Prozeduren sind mir eigentlich klar.
1. Ordner prüfen, ob Dateien vorhanden sind.
2. Wenn neue Dateien da sind -> importieren.
3. Wenn Dateien verändert wurden -> alte Dateieninhalte durch neue Inhalte ersetzen.
Das heisst, ich müsste bei jedem Durchlaufen der Schleife in meinem Code
(Do While sFile "")
den Namen der Datei im Ordner erst einmal vergleichen mit allen Dateinamen, die bereits in meiner Liste stehen. Das ist ja der Code von Franc in seiner Antwort, richtig ?
Daraus folgt, bei seinem Kommentar "'wurde gefunden" folgt dann die Überprüfung nach dem Änderungsdatum und wenn ja, dann das Ersetzen der Inhalte aus der geänderten Datei.
Beim Kommentar "'nicht gefunden" der Import aus meinem Code oben.
Wenn jemand eine Anregung für das "Ändern" der Inhalte hat bei veränderten Dateien bin ich sehr dankbar.
vielen Dank und beste Grüße
Stefan

Anzeige
AW: Reihenfolge beim Import von xls Dateien
07.02.2014 19:09:31
xls
Das Worksheet.Count schaut quasi ob es das gesuchte finden kann. (es sucht nach sFile = Dateiname)
Nur wenn es nicht gefunden wird, wird die Datei importiert.
Die Suche bewirkt im Prinzip das gleiche aber wenn es gefunden wird, können wir rausfinden in welcher Zeile der Suchbegriff steht.
Also gut - ich habs mal angepasst aber ka obs funktioniert.
Wie immer vorher ne Kopie machen und da testen.
Der Unterschied ist folgender.
Bei deiner Variante wurden bisher nur neue Daten übernommen und bereits existierende nicht.
Mit der Änderung werden auch bestehende übernommen und - wenns klappt ^^ - die Daten in der jeweiligen Zeile überschrieben. Es findet aber kein Vergleich statt, ob es sich geändert hat.
If WorksheetFunction.CountIf(wksDATA.Columns(1), sFile) = 0 Then
und
End If
habe ich mit 3 ' auskommentiert. So kannst du sehen was ich geändert habe.
Die Zeilen
.Cells(lRow, 1) = sFile 'Datei merken
.Hyperlinks.Add .Cells(lRow, 1), sPfad & sFile
.Hyperlinks.Add .Cells(lRow, 2), Cells(lRow, 2), TextToDisplay:="select"
habe ich rausgelassen, wenn die Datei schon existiert.
Sub importmodul()
Dim sFile As String, wkb As Workbook, aeRow As Long, lRow As Long, sortLAST As Long, wksDATA   _
As Worksheet, aender As Date
Application.ScreenUpdating = False 'Flackern aus
Const sPfad As String = "mein Pfad"  'anpassen
Set wksDATA = ActiveWorkbook.Sheets("DATA") 'anpassen
sFile = Dir(sPfad & "*.xls*")
aeRow = 5
Do While sFile  ""
aender = Aenderungsdatum(sPfad & sFile)
oldaender = wksDATA.Range("data_aenderung").Cells(aeRow)
MsgBox (oldaender & " " & aender)
'''    If WorksheetFunction.CountIf(wksDATA.Columns(1), sFile) = 0 Then
' neuer Code
' jede Datei wird importiert
Set c = wksDATA.Columns(1).Find(sFile, LookIn:=xlValues, lookat:=xlWhole) 'was wird gesucht
If Not c Is Nothing Then
' wurde gefunden
lRow = c.Row 'lRow ist nun die Zeile wo der Dateiname gefunden wurde
wksDATA.Range("data_aenderung").Cells(lRow) = Aenderungsdatum(sPfad & sFile) ' Datum ü _
berschreiben
Else
' wurde nicht gefunden
With wksDATA
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1) = sFile 'Datei merken
.Hyperlinks.Add .Cells(lRow, 1), sPfad & sFile
.Hyperlinks.Add .Cells(lRow, 2), Cells(lRow, 2), TextToDisplay:="select"
.Range("data_aenderung").Cells(lRow) = Aenderungsdatum(sPfad & sFile)
End With
End If
' neuer Code endet hier
'''    With wksDATA
'''      lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'''      .Cells(lRow, 1) = sFile 'Datei merken
'''      .Hyperlinks.Add .Cells(lRow, 1), sPfad & sFile
'''      .Hyperlinks.Add .Cells(lRow, 2), Cells(lRow, 2), TextToDisplay:="select"
'''      .Range("data_aenderung").Cells(lRow) = Aenderungsdatum(sPfad & sFile)
'''    End With
Set wkb = Workbooks.Open(sPfad & sFile)
With wkb.Sheets(1)
'MsgBox (lRow)
'Daten aus Auftrag Blatt 1 übertragen
wksDATA.Range("data_datum").Cells(lRow) = .Range("datumheute") 'Datum
wksDATA.Range("data_werbeform").Cells(lRow) = .Range("Zwerbeform") 'Werbeform
wksDATA.Range("data_kunde").Cells(lRow) = .Range("kunde") 'Kunde
wksDATA.Range("data_titel").Cells(lRow) = .Range("titel") 'Titel
wksDATA.Range("data_auftragsnummer").Cells(lRow) = .Range("auftragsnummer") '  _
Auftragsnummer
wksDATA.Range("data_berater").Cells(lRow) = .Range("berater") 'Mediaberater
wksDATA.Range("data_basis").Cells(lRow) = .Range("Zbasisprodkosten") 'Basis Budget
wksDATA.Range("data_vkonair").Cells(lRow) = .Range("Zformelsummeonair") 'VK On Air
wksDATA.Range("data_vkonline").Cells(lRow) = .Range("Zformelsummeonline") 'VK  _
Online
wksDATA.Range("data_mediawert").Cells(lRow) = .Range("Zformelsummemedia") ' Media  _
Budget
wksDATA.Range("data_motive").Cells(lRow) = WorksheetFunction.Sum(.Range("zmotive"). _
Value)  'Motive"
wksDATA.Range("data_wm1").Cells(lRow) = .Range("onairauswahl1")  'Werbemittel 1
wksDATA.Range("data_wm2").Cells(lRow) = .Range("onairauswahl2")  'Werbemittel 2
wksDATA.Range("data_wm3").Cells(lRow) = .Range("onairauswahl3")  'Werbemittel 3
wksDATA.Range("data_wm4").Cells(lRow) = .Range("onairauswahl4")  'Werbemittel 4
wksDATA.Range("data_wm5").Cells(lRow) = .Range("onairauswahl5")  'Werbemittel 5
wksDATA.Range("data_wm6").Cells(lRow) = .Range("onairauswahl6")  'Werbemittel 6
wksDATA.Range("data_wm7").Cells(lRow) = .Range("onairauswahl7")  'Werbemittel 7
wksDATA.Range("data_wm8").Cells(lRow) = .Range("onairauswahl8")  'Werbemittel 8
wksDATA.Range("data_gebiet1").Cells(lRow) = .Range("gebiet1") 'Gebiet 1
wksDATA.Range("data_gebiet2").Cells(lRow) = .Range("gebiet2") 'Gebiet 2
wksDATA.Range("data_gebiet3").Cells(lRow) = .Range("gebiet3") 'Gebiet 3
wksDATA.Range("data_gebiet4").Cells(lRow) = .Range("gebiet4") 'Gebiet 4
wksDATA.Range("data_gebiet5").Cells(lRow) = .Range("gebiet5") 'Gebiet 5
wksDATA.Range("data_gebiet6").Cells(lRow) = .Range("gebiet6") 'Gebiet 6
wksDATA.Range("data_gebiet7").Cells(lRow) = .Range("gebiet7") 'Gebiet 7
wksDATA.Range("data_gebiet8").Cells(lRow) = .Range("gebiet8") 'Gebiet 8
wksDATA.Range("data_ow1").Cells(lRow) = .Range("onlineauswahl1") ' Online  _
Werbemittel 1
wksDATA.Range("data_ow2").Cells(lRow) = .Range("onlineauswahl2") ' Online  _
Werbemittel 2
wksDATA.Range("data_ow3").Cells(lRow) = .Range("onlineauswahl3") ' Online  _
Werbemittel 3
wksDATA.Range("data_ow4").Cells(lRow) = .Range("onlineauswahl4") ' Online  _
Werbemittel 4
wksDATA.Range("data_ow5").Cells(lRow) = .Range("onlineauswahl5") ' Online  _
Werbemittel 5
wksDATA.Range("data_ow6").Cells(lRow) = .Range("onlineauswahl6") ' Online  _
Werbemittel 6
wksDATA.Range("data_ow7").Cells(lRow) = .Range("onlineauswahl7") ' Online  _
Werbemittel 7
wksDATA.Range("data_hp1").Cells(lRow) = .Range("homepage1") ' Homepage 1
wksDATA.Range("data_hp2").Cells(lRow) = .Range("homepage2") ' Homepage 2
wksDATA.Range("data_hp3").Cells(lRow) = .Range("homepage3") ' Homepage 3
wksDATA.Range("data_hp4").Cells(lRow) = .Range("homepage4") ' Homepage 4
wksDATA.Range("data_hp5").Cells(lRow) = .Range("homepage5") ' Homepage 5
wksDATA.Range("data_hp6").Cells(lRow) = .Range("homepage6") ' Homepage 6
wksDATA.Range("data_hp7").Cells(lRow) = .Range("homepage7") ' Homepage 7
End With
wkb.Close False
'''    End If
sFile = Dir
aeRow = aeRow + 1
Loop
'sortLAST = wksDATA.Cells(Rows.Count, 2).End(xlUp).Row
'wksDATA.Range("A5:AR" & sortLAST).Sort _
'Key1:=Range("C5"), _
'Order1:=xlDescending
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige