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

Auslesen aus externen Exceldateien

Auslesen aus externen Exceldateien
07.09.2004 12:26:11
Faisal
Hallo Liebe NG!
Folgendes liegt an: Ich habe einen Ordner, in dessen sich 38 Unterordner befinden und denen sich z.Zt. 730(!!) Excel Dateien befinden. Aus jeder Excel Datei interessieren mich die Einträge in den Zellen C6 und G42. Es können immer wieder ein paar neue Dateien dazu kommen. Meine Frage: Hat jemand eine Idee ob die abfrage der nötigen daten automatisiert erfolgen kann und wenn ja, wie?
Ich bin für jede antwort dankbar. Grüsse, Faisal

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

Betreff
Datum
Anwender
Anzeige
AW: Auslesen aus externen Exceldateien
WernerB.
Hallo Faisal,
mal als Denkanstoß: Wenn Du das nachstehende Makro in Verbindung mit der benutzerdefinierten Funktion entsprechend "aufbohrst" (Stichwort "FileSearch" und mit einer Schleife für die Einträge in der Zieldatei), so könnte daraus durchaus etwas Brauchbares entstehen.

Sub AuslesenGeschlDatei()
Dim strSource As String
strSource = "'C:\TEMP\TRALALA\[Datei.xls]Blattname'!R6C3"   'R6C3  = "C6"
Range("B8").Value = xl4Value(strSource)
strSource = "'C:\TEMP\TRALALA\[Datei.xls]Blattname'!R42C7"  'R42C7 = "G42"
Range("B9").Value = xl4Value(strSource)
End Sub


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

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !
Anzeige
AW: Auslesen aus externen Exceldateien
07.09.2004 14:15:59
GraFri
Hallo
Hier das Prinzip. An einigen Punkten (auszulesende Zelle) etc. anpassen.
Bei Unklarheiten melde dich einfach noch mal.


Option Explicit
'Pfad und Name des Tabellenblattes anpassen
Const strPfad = "E:\Excel 2000\Beispiele"
Const strTabelle = "Tabelle1"
Dim strDateiName()      As String
Dim strBezug            As String
Dim intDateiAnzahl      As Integer
Dim intZeile            As Integer
Dim n                   As Integer
Dim datWerte()          As Variant
Sub Abfrage_starten()
    Call Dateien_auslesen
    
    For n = 1 To intDateiAnzahl
        procExternerBereich
    Next n
End Sub
Sub Dateien_auslesen()
Dim objFileSearch       As Object
Set objFileSearch = Application.FileSearch
With objFileSearch
    .LookIn = strPfad
    .Filename = "*.xls"
    .SearchSubFolders = False 'bei True werden alle Unterverzeichnisse mit durchsucht
    
    If .Execute > 0 Then
    intDateiAnzahl = .FoundFiles.Count
    ReDim strDateiName(1 To intDateiAnzahl)
    ReDim datWerte(1 To 3, 1 To intDateiAnzahl)
        For n = 1 To intDateiAnzahl
            strDateiName(n) = Right(.FoundFiles(n), Len(.FoundFiles(n)) - Len(strPfad) - 1) 'nur Dateiname
            MsgBox strDateiName(n)
        Next
    End If
End With
Set objFileSearch = Nothing
End Sub
Private Function funcExternerWert(strPfad, strDatei, strTabelle, strBezug)
Dim strArg              As String
'Pruefung ob die angegebene Datei vorhanden ist
If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
If Dir(strPfad & strDateiName(n)) = "" Then
    funcExternerWert = "Datei nicht vorhanden"
    Exit Function
End If
' Externen Bezug zur Abfrage zusammensetzen
strArg = "'" & strPfad & "[" & strDateiName(n) & "]" & strTabelle & "'!" & Range(strBezug).Range("A1").Address(, , xlR1C1)
' XLM-Makro ausfuehren
funcExternerWert = ExecuteExcel4Macro(strArg)
End Function
Sub procExternerBereich()
Application.ScreenUpdating = False
'In diesem Beispiel wird der Bereich B1:B3 aus den geschlossenen Excelmappen
'aus dem Verzeichnis E:\Excel 2000\Beispiele\ gelesen und in dieser Mappe in den
'Spalten A-C eingetragen
For intZeile = 1 To 3
        strBezug = Cells(intZeile, 2).Address
        datWerte(intZeile, n) = funcExternerWert(strPfad, strDateiName, strTabelle, strBezug)
    MsgBox strDateiName(n)
    MsgBox datWerte(intZeile, n)
Next intZeile
'Aus der geschlossenen Arbeitsmappe E:\Excel 2000\Beispiele\Bereich markieren.xls
'wird die Zelle D2 eingelesen und in der Zelle A12 eingetragen
    strBezug = "$D$2"
    Sheets("Tabelle1").[A12] = funcExternerWert(strPfad, strDateiName, strTabelle, strBezug)
Application.ScreenUpdating = True
End Sub


Mit freundlichen Grüßen, GraFri
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige