Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
940to944
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
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten automatisch einlesen

Daten automatisch einlesen
10.01.2008 11:54:00
Rupert
Hallo Excel-Gemeinde,
Ich hab wieder einmal ein problem, bei dem ich eure hilfe benötigen würde.
Es geht darum bei 5 Excel Dateien den Inhalt der Tabelle 1 in eine Datei einzulesen.
Das ganze möchte ich per VBA lösen.
Mein Hauptproblem ist das es sich um monatliche Dateien handelt, das heisst die Datendateien von Jänner liegen im Ordner Jänner und haben auch im Name das 01-2008, bzw. dann halt 02-2008 usw.
Zuerst möchte ich jede einzelne datei aufrufen,danach den Inhalt der Zieldatei leeren und den Inhalt der Quelldateien beginnend mit A19:L19 bis zur letzten zelle mit werten kopieren (trangend ist hierbei die Spalte A) in die erste freie zelle der Zieldatei kopieren.
Im Prinzip soll das Script folgendes tun.
1) alle datendateien zu öffnen - hab ich
2) alle werte in der Zieldatei zu löschen - hab ich
3) alle daten der einzelnen dateien in die Zieldatei zu kopieren - habe ich nicht
Das Problem welches ich da habe ist das aufrufen der dateien, das ich der dateiname jedes monat
ändert.
Hier mein aktueller Scipt wo ich die Dateien aufrufe und den inhalt der Zieldatei lösche

Sub Daten_Lesen()
Set Datname = ActiveWorkbook
Sheets("BASIC_forecasts ").Select
Dim iCounter As Integer
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\Details"
.SearchSubFolders = False
.Execute msoSortByFileType
.FileType = msoFileTypeExcelWorkbooks
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open FileName:= _
.FoundFiles(iCounter) _
, UpdateLinks:=0
Next iCounter
End With
Datname.Activate
Range("A18:L18").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End Sub


ich bräuchte jetzt wie gesagt nur noch hilfe beim Einlese der Daten aus den Quell-Dateien.
danke schon vorab für die Hilfe
LG
rupert

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten automatisch einlesen
11.01.2008 15:17:30
fcs
Hallo rupert,
ungetestet (mangels Daten) hab ich folgenden Lösungsvorschlag.
Gruß
Franz

Sub Daten_Lesen()
Dim Datname As Workbook, wksZiel As Worksheet, Monatsdateien() As Workbook
Dim iCounter As Integer, lZeileZiel As Long, wksquelle As Worksheet
Set Datname = ActiveWorkbook
Set wksZiel = Sheets("BASIC_forecasts ")
wksZiel.Select
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\Details"
.SearchSubFolders = False
.Execute msoSortByFileType
.FileType = msoFileTypeExcelWorkbooks
ReDim Monatsdateien(1 To .FoundFiles.Count)
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open Filename:= _
.FoundFiles(iCounter) _
, UpdateLinks:=0
Set Monatsdateien(iCounter) = ActiveWorkbook
Next iCounter
End With
Datname.Activate
With wksZiel
.Range(.Cells(18, 1), .Cells(18, 1).End(xlDown).Offset(0, 11)).ClearContents
lZeileZiel = 19
For iCounter = 1 To UBound(Monatsdateien)
Set wksquelle = Monatsdateien(iCounter).Worksheets(1)
wksquelle.Range(wksquelle.Cells(18, 1), _
wksquelle.Cells(18, 1).End(xlDown).Offset(0, 11)).Copy _
Destination:=.Cells(lZeileZiel, 1)
lZeileZiel = .Cells(lZeileZiel, 1).End(xlDown).Row + 1
'Monatsdateien(iCounter).Close
Next
End With
End Sub


Anzeige
AW: Daten automatisch einlesen
14.01.2008 12:35:00
Rupert
Hallo Franz,
Also jetzt bin ich aber baff (wie wir in Wien so sagen), der Code ist der hammer - ich habe lange gebraucht um in so ca. zu verstehen.
Eines wäre jedoch noch der hammer, wenn wir es noch schaffen würden, das er nur werte reinkopiert.
Das wäre dann perfekt.
Hast du da vielleicht noch eine Idee? ich habe es jetzt mit ".PasteSpecial Paste:=xlValues," vor destination probiert - funkt aber nicht.
vielleicht wenn du zeit hast
danke vorab
Rupert

AW: Daten automatisch einlesen
14.01.2008 12:53:00
fcs
Hallo Rupert,
freut mich, dass der Code problemlos funktioniert. Programmieren im Blindflug führt schon leicht mal zu einem Fehler im Ablauf.
Um nur die Werte und ggf. die Zellformate zu übertragen muss du wie folgt anpassen:

For iCounter = 1 To UBound(Monatsdateien)
Set wksquelle = Monatsdateien(iCounter).Worksheets(1)
wksquelle.Range(wksquelle.Cells(18, 1), _
wksquelle.Cells(18, 1).End(xlDown).Offset(0, 11)).Copy
'      .Cells(lZeileZiel, 1).PasteSpecial Paste:=xlFormats
.Cells(lZeileZiel, 1).PasteSpecial Paste:=xlValues
lZeileZiel = .Cells(lZeileZiel, 1).End(xlDown).Row + 1
'Monatsdateien(iCounter).Close
Next


Gruß
Franz

Anzeige
AW: Daten automatisch einlesen
14.01.2008 13:17:45
Rupert
Hallo Franz.
Ich ziehe den Hut vor dir, das ist der absolute hammer - ich bin schwer beeindruckt - thema erledigt.
Woher nimmst du dein wissen, hast du bücher oder diverse Kurse inkl. Doktor in VBA-Prgrammieren?
Herzlichen dasnk dafür
LG
Rupert

AW: Daten automatisch einlesen
14.01.2008 16:06:59
Rupert
Hallo Franz,
Eine Kleinigkeit hätte ich noch gebraucht in diesem Code
Folgendes Szenario, es soll in diese Datei in die Tabelle Calculation der Inhalt einer Datei eingelesen werden, wobei der User dies jeden Tag machen sollte (Datei heisst "Detail" & entsprechendes Datum (z.B. 14.01.2008) und liegt in einem Unterordner der ausführenden Datei.
Soviel habe ich schon mal, hat auch einmal funktioniert, jedoch sobald ein falsches Datum einmal eingegeben wurde (heute habe ich 15.01.2008 eingegeben, die Datei gibt es aber noch nicht, VBA produziert fehler) beim nächsten mal wenn ich das datum richtig eingeben, sagt EXCEL das die Datei nicht existiert, obwohl sie vorhanden ist

Sub Needs_einlesen()
Dim Datname As Workbook, datname1 As Workbook
Set Datname = ActiveWorkbook
Sheets("CALCULATION").Activate
ActiveSheet.Unprotect Password:="GJ"
Range("A3:AK3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Dim datum As String, datumA As String
datumA = InputBox("Geben sie das heutige Datum ein (dd.mm.yyyy)")
If IsDate(datumA) Then
datum = Format(datumA, "dd.mm.yyyy")
End If
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\NEEDS"
Workbooks.Open Filename:= _
"NEEDS " & datum & ".XLS"
End With
Set datname1 = ActiveWorkbook
Selection.RemoveSubtotal
ActiveWindow.LargeScroll ToRight:=1
Selection.AutoFilter Field:=37
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Datname.Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, Password:="GJ"
datname1.Save
datname1.Close
End Sub


hast du eine Idee wie man das vielleicht hinbekommt das es funktioniert?
danke schon vorab
lg
Rupert

Anzeige
AW: Daten automatisch einlesen
14.01.2008 22:55:02
fcs
Hallo Rupert,
ich hab mal die Datumsformatierung für den Dateinamen angepasst und eine Prüfung auf den Dateinamen eingefügt.
Hinweis: Die Verwendung von weiteren Punkten im Dateinamen (zusätzlich zur Trenung der Dateinamens-Erweiterung) ist nicht unbedingt ideal. Besser ist es das Datum ohne trennende Punkte im Dateinamen einzufügen, am besten im Format JJJJMMTT oder JJJJ_MM_DD. So kann man die Dateinamen ggf. auch besser sortieren.
Gruß
Franz

Sub Needs_einlesen()
Dim Datname As Workbook, datname1 As Workbook
Set Datname = ActiveWorkbook
Sheets("CALCULATION").Activate
ActiveSheet.Unprotect Password:="GJ"
Range("A3:AK3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Dim datum As String, datumA As String
datumA = InputBox("Geben sie das heutige Datum ein (TT.MM.JJJJ)")
If IsDate(datumA) Then
datum = Format(CDate(datumA), "DD.MM.YYYY")
If Dir(ThisWorkbook.Path & "\NEEDS\NEEDS " & datum & ".XLS")  "" Then
Workbooks.Open FileName:= _
ThisWorkbook.Path & "\NEEDS\NEEDS " & datum & ".XLS"
Set datname1 = ActiveWorkbook
Selection.RemoveSubtotal
ActiveWindow.LargeScroll ToRight:=1
Selection.AutoFilter Field:=37
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Datname.Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, Password:="GJ"
datname1.Save
datname1.Close
Else
MsgBox "Datei ""NEEDS " & datum & ".XLS"" wurde nicht gefunden!"
End If
Else
MsgBox "Datumseingabe """ & datumA & """ ist ein unzulässiger Wert!"
End If
End Sub


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige