AW: Aus 400 Arbeitsmappen zellen auslesen
08.07.2005 07:59:20
Matthias
Hallo Dieter,
der Folgende Code verlangt in A1 den Pfadnamen, sowie ab Spalte B in Zeile 1 den Blattnamen (z.B. Tabelle1) und in Zeile 2 den Zellnamen (z.B. A1):
| A | B | C |
1 |C:\test |Tabelle1 |Tabelle2 |
2 | |A1 |A1 | ..usw.
Die Dateien werden mit GetValue (eine Funktion, die Werte aus geschlossenen Mappen liest, ich habe diese hier aus dem Forum) ausgelesen.
Der Code:
Option Explicit
'VBA Function to Get a Value From a Closed File
'VBA does not include a method to retrieve a value from a closed file.
'You can, however, take advantage of Excel's ability to work with linked files.
'This tip contains a VBA function that retrieves a value from a closed workbook.
'It does by calling an XLM macro.
'The GetValue Function
'The GetValue function, listed below takes four arguments:
'path: The drive and path to the closed file (e.g., "d:\files")
'file: The workbook name (e.g., "99budget.xls")
'sheet: The worksheet name (e.g., "Sheet1")
'ref: The cell reference (e.g., "C4")
Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
'If Dir(path & file) = "" Then
' GetValue = "File Not Found"
' Exit Function
'End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Auslesen()
Const ErsteZeile = 3
Dim Pfad As String, AnzSpalten As Integer
Dim fn As String, Zeile As Long, Spalte As Integer
Dim i As Integer
Rows(ErsteZeile & ":" & Rows.Count).ClearContents
AnzSpalten = Cells(1, 256).End(xlToLeft).Column
'Debug.Print AnzSpalten
Pfad = Range("A1")
Zeile = ErsteZeile + 1
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
fn = Dir(Pfad & "*.xls")
Application.StatusBar = "Bitte warten..."
Do
For i = 2 To AnzSpalten
Cells(Zeile, 1) = fn
Cells(Zeile, i) = GetValue(Pfad, fn, Cells(1, i), Cells(2, i))
Next i
Zeile = Zeile + 1
fn = Dir()
Loop Until fn = ""
Application.StatusBar = False
End Sub
Grüße,
Matthias