Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
876to880
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
876to880
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten eines bestimmten Verzeichnisses

Daten eines bestimmten Verzeichnisses
08.06.2007 22:30:00
Peter
Guten Abend
Mit nachfolgendem Code lege ich mir in der aktiven Tabelle (benannt: "Dateien")in der Spalte A ein Verzeichnis der Dateien an.
Nun möchte ich den Code wie folgt modifizieren:
1. Es sollen nur xls-Dateien aufgezeichnet werden
2. Sofern die Datei der aktiven Tabelle im Verzeichnis enthalten ist, soll diese nicht aufgeführt werden
3. Dann suche ich eine Routine, wie ich eine Datei nach der anderen bearbeiten kann (schon nur das Gerüst wäre hilfreich; Endziel: ich will jede Datei öffnen und dann immer im jeweils gleich benannten Sheete (z.B. "Tabelle1") ermitteln, welches die letzte Zeile mit einem Eintrag ist und dann Spalte 1:letzte_Zeile_mit_Eintrag kopieren und in die ursprünglich aktive Datei in die Tabelle "Daten" einfügen, und zwar immer ab der Zeile, wo noch nichts darin ist [die zu kopierenden Bereiche sind von den Spalteninhalten identisch und unterscheiden sich nur in der Anzahl Zeilen; Ziel ist alle Daten der einzelnen Dateien in einem File zu haben])
Kann mir jemand zu den einzelnen oder zu einem einzelnen Punkt Lösungshinweise geben?
Hoffe, ich habe die Frage nicht allzu sehr überladen - doch schon einzelne Hinweise wären hilfreich.
Danke, Peter

Sub Dateien()
Dim strDatei As String
Dim lngZ As Long
ActiveSheet.Columns(1) = ""
Application.ScreenUpdating = False
strDatei = Dir("H:\Eportdaten\")
Do Until strDatei = ""
lngZ = lngZ + 1
ActiveSheet.Cells(lngZ, 1) = strDatei
strDatei = Dir
Loop
Application.ScreenUpdating = True
End Sub


2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten eines bestimmten Verzeichnisses
08.06.2007 23:08:59
Matthias
Hallo Peter,
schau dir mal das an:

Sub Dateien()
Const Verz = "D:\Exportdaten\" 'Backslash am Ende nicht vergessen!
Const TabName = "Tabelle1" 'Blattname der Dateien
Const TabZiel = "Daten" ' Blatt in dem die Daten ankommen sollen
Dim strDatei As String
Dim lngZ As Long, i As Long, lr As Long
Dim ShTab As Worksheet
Dim WB As Workbook
Set ShTab = ActiveSheet
ShTab.Columns(1).ClearContents
Application.ScreenUpdating = False
'Verzeichnis auslesen
strDatei = Dir(Verz & "*.xls")
Debug.Print strDatei
Do Until strDatei = ""
If UCase(Verz & strDatei)  UCase(ThisWorkbook.FullName) Then
lngZ = lngZ + 1
ShTab.Cells(lngZ, 1) = strDatei
End If
strDatei = Dir()
Loop
'Dateien nacheinander öffnen
For i = 1 To lngZ
Set WB = Workbooks.Open(Filename:=Verz & ShTab.Cells(i, 1))
'letzte beschriebene Spalte ermitteln:
lr = LastRow(WB.Worksheets(TabName), 1)
'Wenn Spalte nicht leer dann...
If lr > 0 Then
'...Wert in Blatt [TabZiel] eintragen
ThisWorkbook.Sheets(TabZiel).Cells(i, 1) = WB.Worksheets(TabName).Cells(lr, 1)
End If
'Mappe (ohne speichern) schließen
WB.Close False
Next i
Application.ScreenUpdating = True
End Sub
'ermittelt letzte beschriebene Zelle von [Sh] in Spalte [col]
Function LastRow(sh As Worksheet, col As Integer) As Long
Dim rng As Range
Set rng = sh.Cells(sh.Rows.Count, col)
If rng.Value = "" Then
Set rng = rng.End(xlUp)
If rng = "" Then LastRow = 0: Exit Function
End If
LastRow = rng.Row
End Function


Gruß Matthias

Anzeige
AW: Daten eines bestimmten Verzeichnisses
09.06.2007 08:46:00
Peter
Hallo Matthias
Dieser Code finde ich genial, und ich bin schon bald am Ziel. Grossartig, vielen Dank.
Ich habe noch folgende Anpassungen vorgenommen:
1: Der Code ist nicht im aktiven Workbook enthalten, sondern in der persönlichen Makroarbeitsmappe – deshalb habe ich „ThisWorkbook“ mit „ActiveWorkbook“ ersetzt (dies konntest du aus meinen Angaben nicht ableiten)
2. Anstelle einer Constante für das Verzeichnis habe ich nun den Pfad der aktiven Datei einer Variablen zugewiesen
Nun besteht noch folgendes Problem
Der Code bewirkt im Moment, dass der Inhalt der letzten Zeile in Spalte A in die Zieltabelle eingetragen wird. Da in der Spalte A zufälligerweise nichts drin steht, habe ich mal die Spalte B angesprochen.
Nun möchte ich eigentlich nicht nur den Inhalt der letzten Zelle einer bestimmten Spalte in die Zieltabelle übertragen, sondern den Inhalt aller Zeilen – ideal wäre, wenn ich zum Beispiel angeben könnte, wie dieser Bereich ermittelt wird, beispielsweise Spalten A – Y und Zeilen 2 – Zeile mit letztem Eintrag in Spalte B.
Wäre natürlich super, wenn du mir hier nochmals weiterhelfen könntest.
Freundlicher Gruss, Peter
Option Explicit

Sub Dateien()
Const TabName = "GLOBAL" 'Blattname der Dateien
Const TabZiel = "Daten" ' Blatt in dem die Daten ankommen sollen
Dim strVerz As String
Dim strDatei As String
Dim lngZ As Long, i As Long, lr As Long
Dim WBAktiv As Workbook
Dim ShTab As Worksheet
Dim WB As Workbook
Set WBAktiv = ActiveWorkbook
Set ShTab = ActiveSheet
strVerz = ActiveWorkbook.Path & "\" 'Backslash am Ende nicht vergessen!
ShTab.Columns(1).ClearContents
Application.ScreenUpdating = False
'Verzeichnis auslesen
strDatei = Dir(strVerz & "*.xls")
'Debug.Print strDatei
Do Until strDatei = ""
If UCase(strVerz & strDatei)  UCase(ActiveWorkbook.FullName) Then
lngZ = lngZ + 1
ShTab.Cells(lngZ, 1) = strDatei
End If
strDatei = Dir()
Loop
'Dateien nacheinander öffnen
For i = 1 To lngZ
Set WB = Workbooks.Open(Filename:=strVerz & ShTab.Cells(i, 1))
'letzte beschriebene Spalte ermitteln:
lr = LastRow(WB.Worksheets(TabName), 1)
'Wenn Spalte nicht leer dann...
If lr > 0 Then
'...Wert in Blatt [TabZiel] eintragen
WBAktiv.Sheets(TabZiel).Cells(i, 1) = WB.Worksheets(TabName).Cells(lr, 2)
End If
'Mappe (ohne speichern) schließen
WB.Close False
Next i
Application.ScreenUpdating = True
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige