18.08.2020, 07:04 (Dieser Beitrag wurde zuletzt bearbeitet: 18.08.2020, 07:05 von matthes.)
Hallo,
ich habe mir eine Datei zum automatischen Auslesen bestimmten Zellen erstellt. Funktioniert soweit auch.
Jetzt meine Frage, kann man den Code so vereinfachen, dass ich nur den Ordner angebe in dem die auszulesende Datei liegt und nicht jede Datei extra aufführen muss.
Wenn ich das für ein Jahr machen soll, wird der Code sehr lang.
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "0"
Exit Function
End If
Hier ein Versuch Deinen Code etwas zu kürzen. Da ich es nicht prüfen kann, können einige Fehler enthalten sein, Also bitte sorgfältig debuggen:
Code:
const Base as string = "G:\Wasserverteilung\Betriebsdatenprotokolle\2020\"
const Blatt as string = "Gesamtübersicht Teil II"
const Bezug as string = "HB32"
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "0"
Exit Function
End If
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
sub Auslesen()
for i = cdate("1.6.2020") to cdate("31.8.2020")
lr = lr + 1
Pfad = Base & month(i)
Datei = format(i), "DD.MM.YYYY") & ".xls"
cells(lr, 1) = i
cells(lr, 2) = GetValue(Pfad, Datei, Blatt, Bezug)
next i
end sub
Dies sollte den kompletten in der Beispieldatei enthaltenen Code ersetzen.
Du kannst den Monat und das Jahr angeben.
Dann wird ein Blatt z.B. 08.2020 gesucht oder neu angelegt.
Für jeden Tag des Monats (Monatsende wird ermittelt) wird dort ein Eintrag erstellt und der Wert aus der entsprechenden Datei gelesen
in ein Modul.
Code:
Option Explicit
Sub Wasser()
Dim TB As Worksheet
Dim iMonat As Integer, iJahr As Integer
Dim iETag As Date, iLTag As Date, i As Date
Dim Pfad As String, GPfad As String, Datei As String, Blatt As String, Bezug As String
Dim Ext As String, BlName As String
Dim JaNein As Variant, Wert As Variant
Pfad = "E:\Excel\temp\Wasserverteilung\Betriebsdatenprotokolle\" 'MIT \ am Ende
Ext = ".xlsx"
Blatt = "Gesamtübersicht Teil II"
Bezug = "HB32"
iMonat = InputBox("Monat", , Month(Date))
iJahr = InputBox("Jahr", , Year(Date))
iETag = DateSerial(iJahr, iMonat, 1) ' Erster Tag das aktuellen Monats
iLTag = DateSerial(iJahr, iMonat + 1, 0) ' Letzter Tag des aktuellen Monats
'Prüfen, ob Blatt schon vorhanden ist
If IsError(Evaluate(BlName & "!A1")) Then
'Neues Blatt für aktuellen Monat anlegen und benennen
Set TB = Sheets.Add(After:=Sheets(Sheets.Count))
TB.Name = BlName
Else
Set TB = Sheets(BlName)
TB.Cells.Clear
End If
'Daten für jeden Tag des Monats lesen
For i = iETag To iLTag
Datei = GPfad & i & Ext
Wert = GetValue(GPfad, i & Ext, Blatt, Bezug)
If Wert <> "##" Then
TB.Cells(Day(i), 1) = i
TB.Cells(Day(i), 2) = Wert
Else
'Datei nicht vorhanden
JaNein = MsgBox("Datei: '" & i & Ext & "' ist im Verzeichnis:" & vbLf & _
GPfad & vbLf & "nicht vorhanden", vbExclamation + vbOKOnly)
Exit Sub
End If
Next
End Sub
Private Function GetValue(Pfad, Datei, Blatt, Zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
If Dir(Pfad & Datei) = "" Then
GetValue = "##"
Exit Function
End If