VBA aktualisierung, Fehler danach
29.10.2019 17:06:38
Arek
ich habe Probleme nach der Aktualisierung aus csv Dateien. Eine Tabelle wird von mehreren csv Dateien gefüttert. Das Tool wurde vor Jahren mal geschrieben, ich arbeite seit kurzen erst damit und hat nach meinem Wissen schon immer diese verhalten.
Man startet Excel, die Daten werden aus den csv Dateien ohne Fehler kopiert, in Tabellenform. Aus diesen Daten werden bestimmte Zellen gefüttert (Summe, Datum und andere Formeln gebildet) und aus diesen dann nach Track_History geschrieben (Diese dienen der Visualisierung und die aus Track_History werden für Diagramme und "History" benötigt).
Leider erscheinen in Track_History teilweise Daten von gestern obwohl z.B. in der Tabelle BacklogList - F alles stimmt.
Jeden Morgen wird dann in Track_history die aktuelle Zeile gelöscht, das komplette Makro nochmal gestartet per Schaltfläche und jetzt stimmen die Daten auch in Track_History. Habe versucht das mit schleifen oder zwischen durch Speichern, abzufangen brachte aber keine Verbesserung.
Sieht jemand ob da irgendwie einen logischer Fehler oder irgendwie eine Verbesserungsmöglichkeit?
Leider müsste ich zu viel schwärzen um die Datei direkt hochzuladen.
Private Sub Workbook_Open()
Worksheets("Overview").Activate
Call Query_Refresher
End Sub
Als Modul:
Public Sub Query_Refresher()
'Zusätzliche schleife
x = 0
Do
x = x + 1
Cells(x, 57).Value = x
Worksheets("BacklogList - F").Range("D4").Value = "Syncing"
Worksheets("BacklogList - M").Range("D4").Value = "Syncing"
Worksheets("BacklogList - C").Range("D4").Value = "Syncing"
Worksheets("BacklogList - R").Range("D4").Value = "Syncing"
Worksheets("BacklogList - O").Range("D4").Value = "Syncing"
ActiveWorkbook.RefreshAll
Worksheets("BacklogList - F").Range("D4").Value = FileDateTime("Q:\A.csv")
Worksheets("BacklogList - M").Range("D4").Value = FileDateTime("Q:\B.csv")
Worksheets("BacklogList - C").Range("D4").Value = FileDateTime("Q:\C.csv")
Worksheets("BacklogList - R").Range("D4").Value = FileDateTime("Q:\D.csv")
Worksheets("BacklogList - O").Range("D4").Value = FileDateTime("Q:\E.csv")
Loop Until x > 5
Call Track_History
End Sub
Private Sub Track_History()
Line = 2
Do Until Sheets("Track_History").Cells(Line, 1) = ""
If Sheets("Track_History").Cells(Line, 1) = Date Then Exit Sub
Line = Line + 1
Loop
Sheets("Track_History").Cells(Line, 1) = Date
Sheets("Track_History").Cells(Line, 2) = Sheets("Overview").Range("H13").Value
'Zusätzliche schleife
Dim i As Long
For i = 1 To 3
Debug.Print i
'F
Sheets("Track_History").Cells(Line, 3) = Sheets("Overview").Range("I11").Value
#usw.
Sheets("Track_History").Cells(Line, 9) = Sheets("Overview").Range("Y11").Value
'M
Sheets("Track_History").Cells(Line, 10) = Sheets("Overview").Range("I17").Value
#usw.
Sheets("Track_History").Cells(Line, 16) = Sheets("Overview").Range("Y17").Value
'C
Sheets("Track_History").Cells(Line, 17) = Sheets("Overview").Range("I23").Value
#usw.
Sheets("Track_History").Cells(Line, 23) = Sheets("Overview").Range("Y23").Value
'R
Sheets("Track_History").Cells(Line, 24) = Sheets("Overview").Range("I29").Value
#usw.
'O
Sheets("Track_History").Cells(Line, 31) = Sheets("Overview").Range("I35").Value
#usw.
Next
End Sub
Meine jetzige Überlegung war nach heute = Datum zu suchen in Track_History, die Zeile zu löschen und den Ablauf nochmal zu starten.
Habe dazu folgendes gefunden:
Sub Heutige_Datum_finden()
'Findet die Zelle mit dem heutigen Datum ()
Dim rg As Range
Sheets("Track_History").Select
Set rg = ActiveSheet.Columns("A:A").Find(Date, , xlFormulas)
If Not rg Is Nothing Then
rg.Activate
Else
MsgBox "Datum " & Date & " leider nicht gefunden"
End If
Set rg = Nothing
End Sub
Würde das Sinn machen?