Daten aus geschl. Arbeitsblättern

Hallo,
mein Problem wurde schon oft beschrieben, habe auch die Excel-CD durchsucht, aber nicht das richtige gefunden.
Problem: in Datei "test.xls" sollen bestimmte Zellinhalte z.B. A5,B3,C4 aus Datei test1.xls (geschlossen) Zeilenweise eingetragen werden. Ich habe bereits eine sehr umfangreiche Funktion gefunden:
Option Explicit
Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Sub Importieren()
Dim intColumn As Integer, lngRow As Long, strFile As String, strFilename As String, strPath As String
Dim myFileSystemObject As Object
strFile = Space(255)
If IsWinNT Then
GetFileNameFromBrowseW FindWindow("XLMAIN", vbNullString), StrPtr(strFile), 255, StrPtr("C:\dre4we\test"), StrPtr("xls"), StrPtr("Exceldateien (*.xls)" + Chr$(0) + "*.xls" + Chr$(0)), StrPtr("Auswählen")
Else
GetFileNameFromBrowseA FindWindow("XLMAIN", vbNullString), strFile, 255, "C:\dre4we\test", "xls", "Exceldateien (*.xls)" + Chr$(0) + "*.xls" + Chr$(0), "Auswählen"
End If
strFile = Trim$(strFile)
If Len(strFile) > 1 Then
Application.ScreenUpdating = False
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
strFilename = myFileSystemObject.GetFile(strFile).Name
strPath = myFileSystemObject.GetFile(strFile).ParentFolder
Set myFileSystemObject = Nothing
With Worksheets("Tabelle1")
lngRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For intColumn = 2 To 25
.Cells(lngRow, intColumn - 1) = ExecuteExcel4Macro("'" & strPath & "\[" & strFilename & "]Daten'!" & Cells(2, intColumn).Range("A1").Address(, , xlR1C1))
Next
End With
Application.ScreenUpdating = True
End If
End Sub

Private Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = 2)
End Function

Dies ist bis zur Auswahl der Datei nicht schlecht.
Aber wie kann ich jetzt die Zellen definieren die ich auslesen will.
Kann mir da einer von Euch weiter helfen?
Bin für jede Antwort dankbar!!!!

Hallo Detlef,
wie gefällt Dir das?

Sub Detlef()
Dim strSource As String
strSource = "'C:\TEMP\TRALALA\[test1.xls]Tabelle1'!"
With Workbooks("test.xls").Worksheets("Tabelle1")
.Range("A1").Value = xl4Value(strSource & "R5C1")  '="A5"
.Range("A2").Value = xl4Value(strSource & "R3C2")  '="B3"
.Range("A3").Value = xl4Value(strSource & "R4C3")  '="C4"
End With
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !

Hi,
du hast die nötige Funktion xl4Value vergessen! So läuft das natürlich nicht.
Bert

Hallo Bert,
vielen Dank für den Hinweis - wo Du recht hast, hast Du recht ...
'----------------------------------------------------------------------
' Version 01 (mit Funktion):

Function xl4Value(strParam As String) As Variant
xl4Value = ExecuteExcel4Macro(strParam)
End Function

Sub Detlef_01()
Dim strSource As String
strSource = "'C:\TEMP\TRALALA\[test1.xls]Tabelle1'!"
With Workbooks("test.xls").Worksheets("Tabelle1")
.Range("A1").Value = xl4Value(strSource & "R5C1")  '="A5"
.Range("A2").Value = xl4Value(strSource & "R3C2")  '="B3"
.Range("A3").Value = xl4Value(strSource & "R4C3")  '="C4"
End With
End Sub

'----------------------------------------------------------------------
' Version 02 (ohne Funktion):

Sub Detlef_02()
Dim strSource As String
strSource = "'C:\TEMP\TRALALA\[test1.xls]Tabelle1'!"
With Workbooks("test.xls").Worksheets("Tabelle1")
.Range("A1").Value = ExecuteExcel4Macro(strSource & "R5C1")  '="A5"
.Range("A2").Value = ExecuteExcel4Macro(strSource & "R3C2")  '="B3"
.Range("A3").Value = ExecuteExcel4Macro(strSource & "R4C3")  '="C4"
End With
End Sub

'----------------------------------------------------------------------
Gruß
WernerB.

Hallo,
danke für die schnelle Antwort, leider nicht ganz das was ich brauche.
Vieleicht habe ich mich auch schlecht beschrieben.
Ich habe das Beispiel mal angefügt.
Hier nochmal deutlicher.
Ich habe eine Master-Datei, in diese sollen Daten aus geschlossenen Arbeitsmappen eingelesen werden. Diese Arbeitsmappen (zur Zeit 44) werden aber von Woche zu Woche mehr.
Der Inhalt bzw. die auszulesenden Zellen sind aber in allen gleich, also immer die R1C15 oder R2C15 und 21 weiter Zellen. Im Beispiel (auch von Herber) habe ich es schon so weit gebracht, das ich eine Zelle auslesen kann. Wie aber bekomme ich die anderen?
Für weitere Hilfe wäre ich sehr dankbar!
Gruß an alle D. Reyher

Sorry, hier noch das Beispiel
https://www.herber.de/bbs/user/19090.xls

Hallo Detlef,
ich habe Dir hier mal ein Beispielmakro gebastelt, das ich aber aus Zeitmangel leider nicht getestet habe.
Folgende Annahmen (ich bin ja kein Hellseher) liegen diesem Makro zugrunde:
1. Die Dateinamen der relevanten geschlossenen Dateien stehen im Blatt "Import" in der Spalte "A" (Dateiname = letzte 12 Zeichen).
2. Das Blatt in allen geschlossenen Dateien, aus dem jeweils die Zellen "O1", "O2" und "C4" ausgelesen werden sollen, heißt immer "Tabelle1".
3. Alle ausgelesenen Werte sollen untereinander in die Spalte "A" des Blattes "Tabelle2" geschrieben werden.

Sub Detlef()
Dim s1 As String, s2 As String, s3 As String, strSource As String, _
i As Long, laR1 As Long, laR2 As Long
s1 = "'C:\dre4we\test\00\["
s3 = "]Tabelle1'!"
With Sheets("Import")
laR1 = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To laR1
laR2 = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
If laR2 = 1 And Sheets("Tabelle2").Cells(1, 1).Value = "" Then laR2 = 0
s2 = Right(.Cells(i, 1).Text, 12)
strSource = s1 & s2 & s3 & "R1C15"   '= Zelle "O1"
Sheets("Tabelle2").Cells(laR2 + 1, 1).Value = ExecuteExcel4Macro(strSource)
strSource = s1 & s2 & s3 & "R2C15"   '= Zelle "O2"
Sheets("Tabelle2").Cells(laR2 + 2, 1).Value = ExecuteExcel4Macro(strSource)
strSource = s1 & s2 & s3 & "R4C3"    '= Zelle "C4"
Sheets("Tabelle2").Cells(laR2 + 3, 1).Value = ExecuteExcel4Macro(strSource)
Next i
End With
End Sub

Viel Erfolg wünscht
WernerB.

Hallo,
danke für die Mühe, leider nicht das was ich gerne hätte.
Ich habe die Beispieldatei noch mal angefügt.
https://www.herber.de/bbs/user/19140.xls
Ich bin dort schon nahe an meinen Vorstellungen.
Die Dateinamen werden eingelesen Blatt "Import" SpalteA und die erste Zelle aus den Dateien in Spalte B eingetragen. Jetzt fehlen mir aber noch die 22 weiteren Zellen aus den Dateien und diese sollen dann jeweils in die Spalten C bis ... eingetragen werden.
- A=Dateiname, B=1.Wert, C=2.Wert usw.
Vieleicht kann mir jemand den bestehenden Code so anpassen.
Es reichen zwei weiter Beispiel Zellen, den Rest versuche ich dann selber anzupassen.
Im Voraus besten Dank und
Gruß an Alle
Detlef

Hallo Detlef,
ich habe Dir hier noch mal ein Beispielmakro gebastelt, das ich aber aus Zeitmangel nicht getestet habe.
Folgende Annahmen liegen diesem Makro zugrunde:
1. Die Dateinamen der relevanten geschlossenen Dateien stehen im Blatt "Import" in der Spalte "A" (Dateiname = letzte 12 Zeichen).
2. Das Blatt in allen geschlossenen Dateien, aus dem jeweils 22 Zellwerte ausgelesen werden sollen, heißt immer "Tabelle1".
3. Die auszulesenden 22 Zelladressen darfst Du im Row/Column-Modus ("RnCn") noch selbst eintragen.
4. Du kannst das Makro starten, wenn auf dem Blatt "Import" in der Spalte "A" alle Dateinamen eingetragen sind; das Makro arbeitet alle Einträge mittels Schleife nacheinander ab und füllt dabei auf dem Blatt "Import" für jeden Dateinamen die Zellen der Spalten "C" bis "X" (das sind jeweils 22 Einträge für jeden Dateinamen).

Sub Detlef()
Dim s1 As String, s2 As String, s3 As String, strSource As String, _
i As Long, laR As Long
s1 = "'C:\dre4we\test\00\["
s3 = "]Tabelle1'!"
With Sheets("Import")
laR = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To laR
s2 = Right(.Cells(i, 1).Text, 12)
' Hier wird der Wert von Zelle "O1" ausgelesen und in Spalte "C" eingetragen:
strSource = s1 & s2 & s3 & "R1C15"   ' "R1C15" = Zelle "O1"
.Cells(i, 3).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "O2" ausgelesen und in Spalte "D" eingetragen:
strSource = s1 & s2 & s3 & "R2C15"   ' "R2C15" = Zelle "O2"
.Cells(i, 4).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "E" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 5).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "F" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 6).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "G" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 7).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "H" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 8).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "I" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 9).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "J" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 10).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "K" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 11).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "L" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 12).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "M" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 13).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "N" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 14).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "O" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 15).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "P" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 16).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "Q" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 17).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "R" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 18).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "S" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 19).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "T" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 20).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "U" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 21).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "V" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 22).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "W" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 23).Value = ExecuteExcel4Macro(strSource)
' Hier wird der Wert von Zelle "C4" ausgelesen und in Spalte "X" eingetragen:
strSource = s1 & s2 & s3 & "R4C3"    ' "R4C3" = Zelle "C4"
.Cells(i, 24).Value = ExecuteExcel4Macro(strSource)
Next i
End With
End Sub

Viel Erfolg wünscht
WernerB.

Hallo Werner,
genau das wollte ich, großes Lob an Dich und
nochmal recht herzlichen Dank für Deine Hilfe
Den Rest bekomme ich noch hin.
Gruß Detlef

Hallo Werner,
ich will ja nicht unverschämt sein, aber gibt es eine Möglichkeit dies zu beschleunigen.
Bei zur Zeit 44 auszulesenden Datein dauert dies ca. 20 sek. (im Firmen-Netzwerk).
Es werden ca. 250-300 Dateien im laufe des Jahres zusammenkommen und die User sind ungeduldig :).
Wenn keine Möglichkeit besteht, trotzdem recht herzlichen Dank noch mal für die Mühen.
Gruß Detlef

Hallo Detlef,
nach meiner Erfahrung hängt die Dauer des Datenauslesens vorrangig davon ab, ob sich die auszulesenden geschlossenen Dateien lokal auf dem Rechner des Anwenders oder auf einem externen Laufwerk (Netzwerk/Server) befinden. Dieses Verhalten kannst Du auch bei Dateiverknüpfungen beobachten; und die Auslesetechnik des Makros (Excel4-Makro) entspricht ja in weitestem Sinn der von Dateiverknüpfungen.
Gruß
WernerB.