Abruf Informationen aus mehreren geschlossenen Dateien

[Markus_W]

Hallo miteinander,

ich habe eine Frage, zu der ich so noch keinen Foreneintrag gefunden habe.

Ich möchte gerne in meiner Masterdatei zu jeder Kalenderwoche (KW) einen bestimmten Wert aus je einer anderen, geschlossenen Datei einfügen. Diese anderen geschlossene Dateien enthalten verschiedene Werte pro Kalenderwoche. Ich möchte in der Masterdatei gerne die Anzahl an Zeilen der jeweiligen Datei auf dem Laufwerk eintragen lassen, sobald die Datei auf dem Laufwerk verfügbar ist. Das Ergebnis soll in einem Diagram eingetragen werden und den Verlauf der verschiedenen Werte anzeigen. Die Dateien hierzu packe ich in den Anhang.

Das Diagramm habe ich schon entsprechend eingestellt. Was ich nicht hinbekomme ist, die Anzahl der Zeilen aus den jeweiligen Dateien in die entsprechenden Felder der Masterdatei eintragen zu lassen. Ich möchte hierbei keine manuellen Schritte durchfrühren müssen, d.h. ich möchte z.B. nicht prüfen müssen, ob die Daten der neuen Kalenderwoche im Verzeichnis vorhanden sind.

Ich hoffe, ich habe meine Problematik ausreichend geschildert und freue mich über tatkräftige Unterstützung. Vielen Dank!

Freundliche Grüße,

Markus

[UweD]

Hallo

per (Indirekt). Formeln kann man nicht auf geschlossene Dateien zugreifen.

- Aber per VBA kann die Fixe Formel zusammengebaut werden
- Dann bei Bedarf in Werte umwandeln

- Das Jahr muss noch mit einbezogen werden. Das hab ich mal in B1 plaziert

Code:

Sub Werte_ermitteln()
    Dim LW As String, TB1, TB2 As String, LR As Integer, I As Integer, strJahr As String, strKW As Integer, strExt As String
   
    Set TB1 = Sheets("Daten Master")
    TB2 = "Tabelle1" ' Name der Tabelle in KW
   
    strExt = ".xlsx"
   
    LW = ThisWorkbook.Path
   
    With TB1
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
 
        strJahr = .Range("B1") & "_"
       
        For I = 4 To LR
            If Dir(LW & "\" & strJahr & .Cells(I, 1) & strExt) <> "" Then
                With .Cells(I, 2)
                    .FormulaR1C1 = "=COUNT([" & strJahr & .Offset(0, -1) & strExt & "]" & TB2 & "!C4)"
                    .Value = .Value
                End With
                   
            Else
                .Cells(I, 2) = "Datei fehlt"
            End If
        Next
    End With
End Sub

Die verwendete Formel wäre dabe z.B.

Code:

B4: =ANZAHL('X:\Temp\Test\[2019_KW02.xlsx]Tabelle1'!$D:$D)

LG UweD

[Markus_W]

Hallo Uwe,

habe die Daten so geändert, wie du es gesagt hast. Oder ist mir ein Fehler unterlaufen?

Leider funktioniert das ganze noch nicht... Ich habe die Excel-Dateien mal in den Anhang gepackt.

Was muss ich noch tun? Und warum brauche ich in B4 eine Formel? Sollte das nicht das Makro ausfüllen?

Viele Grüße und vielen Dank,

Markus

---

Zusätzlich müsste das Makro alle x Zeitintervalle (z.B. alle 20 Minuten) die Werte aktualisieren, also die Daten aus den geschlossenen Dateien im ordner 2019_KWxx in die Masterdatei importieren...

Viele Grüße,

Markus

[UweD]

Hallo nochmal


Formel in B4: Das war nur zur Verdeutlichung, wie die Formel von VBA zusammengebaut wird.

2 Sachen sind mir aufgefallen

 - Ich hatte Anzahl auf Spalte D verwendet, da dort aber Text steht und die Formel nur Zahlen zählen soll, kam immer 0 heraus. Ich nehme jetzt Spalte M
 - Ich hatte die Formel bei geöffneter KW- Datei probiert. Da wird dann das Laufwerk nicht mit verwendet. Das habe ich geändert.


Das Makro wiederholt sich nun alle 20 Minuten. Um das zu stoppen, musst du einmal "StopLoad" laufen lassen


Hier nochmal der komplette Code

Code:

Option Explicit
Dim NextInst As Date

Sub Werte_ermitteln()
    Dim LW As String, TB1, TB2 As String, LR As Integer, I As Integer, strJahr As String, strKW As Integer, strExt As String
  
    Set TB1 = Sheets("Daten Master")
    TB2 = "Tabelle1" ' Name der Tabelle in KW
  
    strExt = ".xlsx"
  
    LW = ThisWorkbook.Path
  
    With TB1
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte

        strJahr = .Range("B1") & "_"
      
        For I = 4 To LR
            If Dir(LW & "\" & strJahr & .Cells(I, 1) & strExt) <> "" Then
                With .Cells(I, 2)
                   .FormulaR1C1 = "=COUNT('" & LW & "\[" & strJahr & .Offset(0, -1) & strExt & "]" & TB2 & "'!C13)"
                    .Value = .Value
                End With
                  
            Else
                .Cells(I, 2) = "Datei fehlt"
            End If
        Next
    End With
   
    NextInst = Now + TimeValue("00:20:00")
    Application.OnTime NextInst, "Werte_ermitteln"

End Sub


Sub StopLoad()
    On Error Resume Next
    Application.OnTime NextInst, "Werte_ermitteln", , False
End Sub

LG UweD

[Markus_W]

Hallo Uwe,

vielen lieben Dank.

Viele Grüße,

Markus

[Markus_W]

Hallo Uwe,

leider ploppt nach einiger Zeit (ich bilde mir ein, dass es nicht die 20min sind...) ploppt eine Meldung auf (siehe Anahng). Was muss ich noch tun?

   

Viele Grüße,

Markus

[UweD]

Hallo

Hast du die Datei mitleweile geschlossen?

Stell mal auf z.b. 30 sek um und beobachte

Code:

NextInst = Now + TimeValue("00:20:00")

ändern

Code:

NextInst = Now + TimeValue("00:00:30")

LG UweD

[Markus_W]

Hi uwe,

wenn ich auf 30 Sekunden umstelle, passiert das Ganze nach 30 Sekunden :).

Lg, Markus

[UweD]

Leider keine Ahnung


Bei mir läuft das.

[schauan]

Hallöchen,

hast Du schon mal nach der Datei und dem Makro geschaut, die in der Fehlermeldung genannt werden?