da ich bei meiner Fehlersuche immer wieder auf dies Forum stieß, jedoch nach über 2 Wochen noch immer zu keiner zufriedenstellenden Lösung gekommen bin, möchte
ich Euch bitten mir einen Rat zu geben oder mich auf evtl. Fehler aufmerksam zu machen.
Situation: Ich habe etwa 30 xls Mappen, mit je 33 Tabellen, aus denen ich versuche 2 bzw. 3 Werte (die Bezeichnungen stehen in der 1. Zeile) auszulesen und in ein neues Dokument zu speichern. Dazu habe ich das folgende Programm geschrieben:
Option Explicit
Sub test()
'Variablendeklaration
Dim WS As Worksheet
Dim WSName As String
Dim TabEnd As Integer
Dim i As Integer
'Zieldatei anlegen
Workbooks.Add
Application.CutCopyMode = False
ChDir "C:\Desktop"
ActiveWorkbook.SaveAs Filename:="C:\Desktop\Dauerspeicherdaten_Exzerp.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False '!ggf. Pfad anpassen!
ActiveWindow.Close
'geöffnete Mappe nach Schlüsselwörtern durchsuchen und darunterliegende Werte in zuvor _
angelegte Zieldatei kopieren
For Each WS In ActiveWorkbook.Worksheets
WSName = WS.Name
TabEnd = Sheets(WS.Name).Columns.Count
'Debug.Print TabEnd
For i = 1 To TabEnd
If StrComp("Zeit2", Sheets(WSName).Cells(1, i)) = 0 Then
Sheets(WSName).Cells(2, i).Copy
Workbooks.Open Filename:= _
"Dauerspeicherdaten_Exzerp.xlsx"
Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
'Sheets(WSName).Select
ActiveWindow.Close
'Debug.Print Sheets(WSName).Cells(2, i)
Sheets(WSName).Cells(3, i).Copy
Workbooks.Open Filename:= _
"Dauerspeicherdaten_Exzerp.xlsx"
Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets(WSName).Cells(4, i).Copy
Workbooks.Open Filename:= _
"Dauerspeicherdaten_Exzerp.xlsx"
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End If
If StrComp("p_Umgebung", Sheets(WSName).Cells(1, i)) = 0 Then
Sheets(WSName).Cells(3, i).Copy
Workbooks.Open Filename:= _
"Dauerspeicherdaten_Exzerp.xlsx"
Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets(WSName).Cells(4, i).Copy
Workbooks.Open Filename:= _
"Dauerspeicherdaten_Exzerp.xlsx"
Cells(Cells(Rows.Count, "F").End(xlUp).Row + 1, "F").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End If
Next i
Next WS
End Sub
Im Anschluss führe ich die so entstandenen Exzerpe zusammen.Mir ist bewusst, dass das Öffnen und schließen der Ziel-Datei bestimmt unständlich ist, eine Vereinfachung wäre wünschenswert. Ich bin auch für vereinfachende Tipps dankebar - nur erschien mir die Struktur günstig zum debuggen.
Als Fehler bekomme ich mal den berühmten Fehler 400, auch den Laufzeitfehler 9 "Index außerhalb des gültigen Bereichs" und den Fehler 1004 angezeigt.
Es funktioniert seltsamer Weise zuverlässig wenn ich die ersten 1-5 Tabellen einer Mappe lösche und die ersten 5 dann separat auswerte. Einmal funktionierte es auch, nachdem ich den aller ersten Wert der kopiert werden sollte von 2502 auf 1 änderte.
Von den verbleibenden 4 Werten von Interesse sind 2 Zahlen zwischen 950 und 1050 und 2 mal Daten der Form "30.04.2015 16:41" in einer Zelle. Pro Tabelle stehen die 4 Werte etwa 3 mal, eine Tabelle ist immer 256 Spalten breit, aber bis zu 40 000 Zeilen lang. Mich interessieren allerdings nur die Werte bis Zeile 4, darunter könnte man alles löschen mit einem Makro, aber das für all die Dateien umzusetzen mache ich nur, wenn es Erfolg verspricht, da ich das Makro noch manuell in der jeweiligen Mappe ausführen muss und es sich die Dateien nicht mit bspw.:
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Cells(row, column).Address(ReferenceStyle:=xlR1C1)
'Ausführen des XL4-Makros
getValueFromFile = ExecuteExcel4Macro(arg)
selbst holt.
Liebe Community ich bitte um konstruktive Anregungen, da ich mit der Problematik inzwischen leider sehr in Zeitnot geraten bin.
Aufrichtigen Dank
Fritz
PS: beim debuggen werden mir im Falle, dass es nicht funktioniert, zumeist die Zeile
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
markiert. Die xlsm 's, sind zwischen 100MB und 300MB groß.