Daten aus unterschiedlichen Dateien

Forumthread: Daten aus unterschiedlichen Dateien

10.11.2020 11:58:23

Musa

Hallo zusammen,
folgendes Problem:
ich möchte aus unterschiedlichen Dateien, Daten in einer Tabelle sammeln, immer mit Bezug auf den Dateinamen (Dateiname=Datum).
Wenn ich in meine Zelle das gewünschte Datum schreibe, möchte ich aus den unterschiedlichen Dateien, die gewünschten Daten.
Beispieldatei für die Datensammlung (hier werde ich mein Datum reinschreiben und möchte die gewünschten Werte angezeigt bekommen):
https://www.herber.de/bbs/user/141447.xlsx
Beispieldateien für die Daten:
https://www.herber.de/bbs/user/141448.xlsx
https://www.herber.de/bbs/user/141449.xlsx
Vielen Dank für eure Unterstützung :)(:
Gruß, Musa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten aus unterschiedlichen Dateien

10.11.2020 12:09:35

Nepumuk

Hallo Musa,
wie sieht den der Name der Daten-Dateien im original aus?
Gruß
Nepumuk

AW: Daten aus unterschiedlichen Dateien

10.11.2020 12:13:39

Musa

Hallo Nepumuk,
die Dateien sind nach Datum benannt z.b.:
2020_11_10
2020_11_09
2020_11_08
usw..
Gruß, Musa

AW: Daten aus unterschiedlichen Dateien

10.11.2020 12:43:36

Nepumuk

Hallo Musa,
Rechtsklick auf den Tabellenreiter - Code anzeigen. Folgende Prozedur einfügen:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strDate As String
    Dim objWorkbook As Workbook, objCell As Range
    Dim lngRow As Long
    If Target.Address = "$B$2" Then
        If IsDate(Target.Value) Then
            strDate = Format$(Target.Value, "yyyy_mm_dd")
            If Dir$(ThisWorkbook.Path & "\" & strDate & ".xlsx") <> vbNullString Then
                Set objWorkbook = GetObject(PathName:=ThisWorkbook.Path & "\" & strDate & ".xlsx")
                For lngRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row
                    Set objCell = objWorkbook.Worksheets(1).Cells.Find(What:=Cells(lngRow, 2).Text, _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                    If Not objCell Is Nothing Then Cells(lngRow, 3).Value = objCell.Offset(0, 1).Value
                    Set objCell = Nothing
                Next
                Call objWorkbook.Close(SaveChanges:=False)
                Set objWorkbook = Nothing
            Else
                Call MsgBox("Datei nicht gefunden", vbExclamation, "Hinweis")
            End If
        Else
            Call MsgBox("Kein gültiges Datum.", vbExclamation, "Hinweis")
        End If
    End If
End Sub

Gruß
Nepumuk

AW: Daten aus unterschiedlichen Dateien

10.11.2020 14:00:47

Musa

Also funktioniert schon mal klasse in den Beispieldateien.
Ich glaube hier muss aber meine Datei mit der "Datensammlung" im gleichen Ordner wie die Daten gespeichert sein?
Wie muss der Code den aufgebaut sein, wenn die Datensammlung und die Daten-Dateien unterschiedliche Pfade haben?
Gruß, Musa

AW: Daten aus unterschiedlichen Dateien

10.11.2020 14:12:26

Nepumuk

Hallo Musa,
so:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const FOLDER_PATH As String = "H:\1110\" 'Anpassen !!! Backslash am Ende nicht löschen
    Dim strDate As String
    Dim objWorkbook As Workbook, objCell As Range
    Dim lngRow As Long
    If Target.Address = "$B$2" Then
        If IsDate(Target.Value) Then
            strDate = Format$(Target.Value, "yyyy_mm_dd")
            If Dir$(FOLDER_PATH & strDate & ".xlsx") <> vbNullString Then
                Set objWorkbook = GetObject(PathName:=FOLDER_PATH & strDate & ".xlsx")
                For lngRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row
                    Set objCell = objWorkbook.Worksheets(1).Cells.Find(What:=Cells(lngRow, 2).Text, _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                    If Not objCell Is Nothing Then Cells(lngRow, 3).Value = objCell.Offset(0, 1).Value
                    Set objCell = Nothing
                Next
                Call objWorkbook.Close(SaveChanges:=False)
                Set objWorkbook = Nothing
            Else
                Call MsgBox("Datei nicht gefunden", vbExclamation, "Hinweis")
            End If
        Else
            Call MsgBox("Kein gültiges Datum.", vbExclamation, "Hinweis")
        End If
    End If
End Sub

Gruß
Nepumuk

AW: Daten aus unterschiedlichen Dateien

10.11.2020 14:35:51

Musa

Hey das klappt alles wunderbar, ich sollte nur vermutlich alle meine Vorstellung am Schlag aufschreiben.
Was ich nicht erwähnt habe:
Ablageort ist eigentlich kein Ordner, sondern ein SharePoint z.b.: https://.../
und ich müsste nicht einen sondern insg. 3 Spalten neben dem Suchkriterium wiedergeben.
Danke :)(:

AW: Daten aus unterschiedlichen Dateien

10.11.2020 14:51:47

Nepumuk

Hallo Musa,
ich habe keinen Server, daher kann ich nicht testen ob es so funktioniert:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const FOLDER_PATH As String = "https://.../" 'Anpassen !!! Slash am Ende nicht löschen
    Dim strDate As String
    Dim objWorkbook As Workbook, objCell As Range
    Dim lngRow As Long
    On Error GoTo err_exit
    If Target.Address = "$B$2" Then
        If IsDate(Target.Value) Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
            strDate = Format$(Target.Value, "yyyy_mm_dd")
            Set objWorkbook = GetObject(PathName:=FOLDER_PATH & strDate & ".xlsx")
            For lngRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row
                Set objCell = objWorkbook.Worksheets(1).Cells.Find(What:=Cells(lngRow, 2).Text, _
                    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If Not objCell Is Nothing Then
                    Cells(lngRow, 3).Value = objCell.Offset(0, 1).Value
                    Cells(lngRow, 4).Value = objCell.Offset(0, 2).Value
                    Cells(lngRow, 5).Value = objCell.Offset(0, 3).Value
                End If
                Set objCell = Nothing
            Next
            Call objWorkbook.Close(SaveChanges:=False)
            Set objWorkbook = Nothing
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
        Else
            Call MsgBox("Kein gültiges Datum.", vbExclamation, "Hinweis")
        End If
    End If
    Exit Sub
    err_exit:
    Call MsgBox("Datei nicht gefunden", vbExclamation, "Hinweis")
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

AW: Daten aus unterschiedlichen Dateien

10.11.2020 14:58:13

max.kaffl@gmx.de

Ich nochmal,
ich habe es mit einer Datei aus dem Forum versucht. Das funktioniert nicht mit GetObject.
Also, ersetze diese Zeile:

Set objWorkbook = GetObject(PathName:=FOLDER_PATH & strDate & ".xlsx")

durch diese:

Set objWorkbook = Workbooks.Open(Filename:=FOLDER_PATH & strDate & ".xlsx")

Gruß
Nepumuk

AW: Daten aus unterschiedlichen Dateien

12.11.2020 12:12:09

Musa

Perfekt, Dankeschön!

Beliebteste Forumthreads (12 Monate)

Daten aus unterschiedlichen Dateien

Forumthread: Daten aus unterschiedlichen Dateien

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread