AW: Zeilen löschen wenn...
10.01.2017 13:46:02
Al
Das klappt super, vielen Dank euch allen für die schnelle Hilfe.
Ich habe mal eine Frage: Ich lade über einen Makro aus diversen Ordnern Daten aus sehr vielen Excelblättern in eine andere Exceldatei. Nach einem gewissen Zeitraum muss ich erneut schauen, ob in diesen Ordnern neue Exceldateien mit entsprechenden Daten enthalten sind. Momentan, so wie mein Makro arbeitet, werden allerdings alle Daten (sowohl aus neuen als auch alten Excelblättern) erneut geladen. D.h. dass alte Daten erneut in die Liste geschrieben werden (daher auch die doppelt vorkommenden Zeilen) und ich mit dem Makro "DoppelteZeilenLoeschen" diese wieder entfernen muss.
Fällt jemanden eine elegantere Lösung ein, damit die alten nicht erneut geladen werden? Oder vielleicht kann man das Makro DoppelteZeilenLoeschen direkt in das angehängte Makro integrieren? Ich frage aus dem einfachen Grunde, weil das Laden der Daten aus den Verzeichnissen mit Unterverzeichnissen... relativ lange dauert.
Danke für eure Hilfe.
Option Explicit
Dim fso As FileSystemObject
Dim zeileZ As Long
Dim wsZ As Worksheet 'Zielblatt
Sub DatenAuslesen_mit_Unterverz()
Dim ergebnis As Long
Dim fd As FileDialog
Dim fol As Folder
Dim letzteZeileZ As Long
Dim pfad As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.InitialFileName = ThisWorkbook.Path & "\"
ergebnis = fd.Show
If ergebnis = 0 Then 'Vorgang bei Abbruch
' MsgBox Prompt:="Abbruch durch den Benutzer"
Exit Sub
End If
pfad = fd.SelectedItems(1)
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pfad)
Set wsZ = ThisWorkbook.Worksheets("Datenauslese")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
zeileZ = letzteZeileZ + 1
Folder_abarbeiten Verzeichnis:=fol
Set fso = Nothing
End Sub
Sub Folder_abarbeiten(Verzeichnis As Folder)
Dim fil As File
Dim fol As Folder
Dim pos As Long
Dim suchErgebnis As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim zeichNr As String
Dim zeileStahlgewicht As Long
For Each fil In Verzeichnis.Files
If fil.Name Like "*.xls*" Then 'nur xls Dateien _
oeffnen
pos = InStrRev(fil.Name, ".")
zeichNr = Left$(fil.Name, pos - 1) 'Zeichnungsnr aus _
Dateiname
If Len(zeichNr)