Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1656to1660
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
Inhaltsverzeichnis

Zusammenfassung Ordner in einer Datei

Zusammenfassung Ordner in einer Datei
25.11.2018 19:00:38
Christoph
Hallo,
Ich habe seit Tagen eine Idee und frage mich nun ob diese umsetzbar ist und wenn ja wie.
Ich hätte gerne das Zelle "O4" aus allen vorhandenen Dateien in eine seperate Datei kopiert wird. Das ganze soll Monatsweise geschehen und dem Tag zugeordnet welcher das Datum in Benutzerdefiniertem Format (TTMMJJ) in Zelle "B2" enthält. In der sepersten Datei sind die Tage des Monats untereinander fortlaufend, 12 Tabellen nebeneinander.
In diesen Ordner, wo sich dann alle Dateien befinden aus denen der Bezug geschehen soll, werden regelmäßig neue Dateien zugefügt, wodurch also die Anzahl an Dateien stetig wächst.
Ist dies realisierbar? LG

30
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 19:50:44
Sepp
Hallo Christoph,
das ist möglich, allerdings bleiben ein paar Fragen.
  1. Aus welchem Tabellenblatt der Quelldateien sollen die Werte ausgelesen werden?
  2. Sollen alle XL-Dateien des Ordners ausgelesen werden?
  3. Sollen beim erneuten starten des Makros bereits ermittelte Werte überschrieben werden?
  4. Wo sollen in der Zieldatei die Daten geschrieben werden?
  5. Wie heißen die Tabellenblätter in der Zieldatei?

 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 20:24:16
Christoph
Hallo Sepp,
Zu 1./ Die Daten sollen aus dem ersten Tabellenblatt ausgelesen werden. Die Zelle dafür ist "O4" in jeder Datei.
Zu 2./ Alle Dateien die sich in dem Ordner befinden sollen ausgelesen werden plus die Dateien die neu dazu kommen,
Zu 3./ Alle Daten sollen erhalten bleiben, wenn neue Dateien in den Ordner eingefügt werden sollen die Einträge entsprechend dem Datum der Datei aus Zelle "B2" in die neue Datei eingefügt werden.
Zu 4./ ab "B4" + 30 Tage untereinander für Januar, "D4" + 27 Tage für Februar usw.
Zu 5./ Die Zieldatei wird nur ein Tabellenblatt mit den 12 Tabellen enthalten. Heißen wird/soll sie "NoShow Zähler"
Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 20:43:24
Sepp
Hallo Christoph,
hat das 'erste' Tabellenblatt immer den selben Namen und wenn ja, welchen?
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 20:55:16
Christoph
Das erste Tabellenblatt heißt immer gleich und hört auf den Namen "Anwesenheitsliste".
Bei der Zelle mit dem Datumsbezug hab ich mich allerdings vermacht. Das Datum steht immer in Zelle "C1".
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 21:04:08
Sepp
Hallo Christoph,
in ein allgemeines Modul der Zieldatei.
Modul Modul1
Option Explicit 
 
Sub collectData() 
  Dim strFile As String 
  Dim varRet As Variant, varDate As Variant, varValue As Variant 
  Dim lngRow As Long, lngCol As Long 
 
  Const FILEPATH As String = "D:\Forum\Test\"       'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL As String = "C1"                   'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
   
  strFile = Dir(FILEPATH & "*.xls*", vbNormal) 
 
  Do While strFile <> "" 
    varRet = Application.Match(strFile, Sheets("Update").Columns(1), 0) 
    If IsError(varRet) Then 
      With Sheets("Update") 
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = strFile 
      End With 
      varDate = GetValue(FILEPATH, strFile, SHEETNAME, "B2") 
      varValue = GetValue(FILEPATH, strFile, SHEETNAME, "O4") 
      If IsNumeric(varDate) Then 
        With Sheets("NoShow Zähler") 
          If Year(.Range("B4")) = Year(varDate) Then 
            lngCol = Month(varDate) * 2 + 1 
            lngRow = Day(varDate) + 3 
            .Cells(lngRow, lngCol) = varValue 
          End If 
        End With 
      End If 
    End If 
    strFile = Dir 
  Loop 
 
End Sub 
 
Private Function GetValue(ByVal Path As String, ByVal File As String, ByVal Sheet As String, ByVal Ref As String) As Variant 
  Dim arg As String 
 
  On Error GoTo ErrorHandler 
 
  If Right(Path, 1) <> "\" Then Path = Path & "\" 
 
  arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref).Range("A1").Address(, , xlR1C1) 
 
  GetValue = ExecuteExcel4Macro(arg) 
 
  Exit Function 
ErrorHandler: 
  GetValue = CVErr(xlErrRef) 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


In der Zieldatei legst du ein neues Tabellenblatt mit dem Namen 'Update' an, dieses kannst du ausblenden. In diesem Blatt werden die Dateinamen der ausgelesenen dateien gespeichert. Für ein erneutes einlesen oder zum Testen einfach die Einträge in Spalte A löschen.
Beim Einlesen wird auch das Jahr berücksichtigt, dazu wird das Datum in B4 herangezogen!
Außerdem gehe ich davon aus, das in C1 ein 'echtes' Datum steht.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 21:18:42
Christoph
Wow, super Vielen dank. Ich werde es morgen umgehend testen und dir ein Feedback da lassen.
Eine Frage hab ich allerdings zum erneuten einlesen, das ist so gemeint das man nach jedem hinzufügen neuer Dateien das Update Tabellenblatt aufrufen muss und die Einträge in "A" löschen muss, so richtig verstanden?
In C1 steht ein echtes Datum, allerdings im Benutzerdefinierten Format von TTMMJJ.
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 21:24:25
Sepp
Hallo Christoph,
nein, die Einträge in 'Update' musst du nur löschen, wenn du alle Dateien erneut einlesen willst, damit wird nämlich geprüft, ob eine Datei schon eingelesen wurde, neue Dateien stehen ja noch nicht in der Liste und werden natürlich eingelesen.
Hie ein nochmals angepasster Code.
Sub collectData()
  Dim strFile As String
  Dim varRet As Variant, varDate As Variant, varValue As Variant
  Dim lngRow As Long, lngCol As Long

  Const FILEPATH  As String = "D:\Forum\Test\"      'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL  As String = "C1"                  'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
  
  strFile = Dir(FILEPATH & "*.xls*", vbNormal)

  Do While strFile <> ""
    varRet = Application.Match(strFile, Sheets("Update").Columns(1), 0)
    If IsError(varRet) Then
      varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL)
      varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL)
      If IsNumeric(varDate) Then
        With Sheets("NoShow Zähler")
          If Year(.Range("B4")) = Year(varDate) Then
            lngCol = Month(varDate) * 2 + 1
            lngRow = Day(varDate) + 3
            .Cells(lngRow, lngCol) = varValue
            With Sheets("Update"): .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = strFile: End With
          End If
        End With
      End If
    End If
    strFile = Dir
  Loop

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Zusammenfassung Ordner in einer Datei
25.11.2018 21:56:14
Christoph
Ok also wenn eine neue Datei hinzugefügt wird, dann wird diese auch automatisch eingelesen?
Wenn sich innerhalb der Datei im Nachgang noch etwas ändert muss Spalte A in Updates gelöscht werden?
Genau! o.T.
25.11.2018 22:09:13
Sepp
 ABCDEF
1Gruß Sepp
2
3

Anzeige
Wobei man mit wenig Aufwand...
25.11.2018 22:27:33
Sepp
... auch das Datum der letzten Änderung überprüfen kann. Damit werden jene Dateien erneut eingelesen, die seit dem letzten Einlesen geändert wurden.
Sub collectData()
  Dim strFile As String
  Dim varRet As Variant, varDate As Variant, varValue As Variant
  Dim lngRow As Long, lngCol As Long
  Dim dblFileTime As Double, dblCheckTime As Double
  
  Const FILEPATH  As String = "D:\Forum\Test\"      'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL  As String = "C1"                  'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
  
  Set objFSO = CreateObject("Scripting.Filesystemobject")
  
  strFile = Dir(FILEPATH & "*.xls*", vbNormal)

  Do While strFile <> ""
    dblCheckTime = CDbl(FileDateTime(FILEPATH & strFile))
    With Sheets("Update")
      varRet = Application.Match(strFile, .Columns(1), 0)
      If IsNumeric(varRet) Then dblFileTime = .Cells(varRet, 2)
    End With
    If IsError(varRet) Or dblCheckTime > dblFileTime Then
      varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL)
      varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL)
      If IsNumeric(varDate) Then
        With Sheets("NoShow Zähler")
          If Year(.Range("B4")) = Year(varDate) Then
            lngCol = Month(varDate) * 2 + 1
            lngRow = Day(varDate) + 3
            .Cells(lngRow, lngCol) = varValue
            With Sheets("Update")
              If IsNumeric(varRet) Then
                .Cells(varRet, 2) = dblCheckTime
              Else
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = strFile
                .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = dblCheckTime
              End If
            End With
          End If
        End With
      End If
    End If
    strFile = Dir
  Loop

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
Mist! schon wieder der falsche Code ;-))
25.11.2018 22:29:11
Sepp
Modul Modul1
Option Explicit 
 
Sub collectData() 
  Dim strFile As String 
  Dim varRet As Variant, varDate As Variant, varValue As Variant 
  Dim lngRow As Long, lngCol As Long 
  Dim dblFileTime As Double, dblCheckTime As Double 
   
  Const FILEPATH  As String = "D:\Forum\Test\"      'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL  As String = "C1"                  'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
     
  strFile = Dir(FILEPATH & "*.xls*", vbNormal) 
 
  Do While strFile <> "" 
    dblCheckTime = CDbl(FileDateTime(FILEPATH & strFile)) 
    With Sheets("Update") 
      varRet = Application.Match(strFile, .Columns(1), 0) 
      If IsNumeric(varRet) Then dblFileTime = .Cells(varRet, 2) 
    End With 
    If IsError(varRet) Or dblCheckTime > dblFileTime Then 
      varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL) 
      varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL) 
      If IsNumeric(varDate) Then 
        With Sheets("NoShow Zähler") 
          If Year(.Range("B4")) = Year(varDate) Then 
            lngCol = Month(varDate) * 2 + 1 
            lngRow = Day(varDate) + 3 
            .Cells(lngRow, lngCol) = varValue 
            With Sheets("Update") 
              If IsNumeric(varRet) Then 
                .Cells(varRet, 2) = dblCheckTime 
              Else 
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = strFile 
                .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = dblCheckTime 
              End If 
            End With 
          End If 
        End With 
      End If 
    End If 
    strFile = Dir 
  Loop 
 
End Sub 
 
Private Function GetValue(ByVal Path As String, ByVal File As String, ByVal Sheet As String, ByVal Ref As String) As Variant 
  Dim arg As String 
 
  On Error GoTo ErrorHandler 
 
  If Right(Path, 1) <> "\" Then Path = Path & "\" 
 
  arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref).Range("A1").Address(, , xlR1C1) 
 
  GetValue = ExecuteExcel4Macro(arg) 
 
  Exit Function 
ErrorHandler: 
  GetValue = CVErr(xlErrRef) 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Mist! schon wieder der falsche Code ;-))
26.11.2018 08:54:33
Christoph
Hallo Sepp,
wie versprochen habe ich mich heute morgen direkt an die neue Datei gewagt und diese wie beschrieben erstellt, den Code in ein allgemeines Modul hinzugefügt aber es tut sich nichts.
Woran kann das liegen bzw was kann ich verkehrt gemacht haben?
LG
AW: Mist! schon wieder der falsche Code ;-))
26.11.2018 18:06:45
Sepp
Hallo Christoph,
aus der Ferne schwer zu beurteilen.
  • Pfad angepasst?
  • Tabellenblattnamen richtig?
  • Tabelle 'Update' vorhanden?
  • Zelladressen korrekt?

 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Mist! schon wieder der falsche Code ;-))
26.11.2018 19:59:38
Christoph
Hallo Sepp,
Der Pfad wurde angepasst, die Tabellenblattnamen sind korrekt, das Tabellenblatt "Update" wurde erstellt und ausgeblendet und die Zelladressen wurden kontrolliert und diese sind auch korrekt.
Den Code habe ich als normales Modul unter der Arbeitsmappe eingefügt und dann "Schließen und zurück zu Excel" geklickt.
AW: Mist! schon wieder der falsche Code ;-))
26.11.2018 20:23:35
Sepp
Hallo Christoph,
und das Makro gestartet? Alt&F8 > Makro auswählen und Enter.
 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
27.11.2018 08:14:58
Christoph
Hallo Sepp,
Makro ist über Alt&F8 gestartet, auf dem Update Blatt erscheint kein Eintrag und auf dem Tabellenblatt 1 "NoShow Zähler" auch nicht.
AW: Mist! schon wieder der falsche Code ;-))
27.11.2018 10:06:44
Sepp
Hallo Christoph,
der Code wurde von mir mehrfach getestet und läuft fehlerlos.
Warum es bei dir nicht klappt, ist schwer zu beurteilen.
Stimmt die Pfadangabe mit abschließendem "\"?
Zeig mal einer der Quelldateien.
Gruß Sepp
AW: Mist! schon wieder der falsche Code ;-))
27.11.2018 11:57:42
Christoph
Hallo Sepp,
die Pfadeangabe ist korrekt und wurde wie folgt eingegeben "Z:\1_Bewerbertag\Infopoint Anwesenheitsliste\Alt\"
https://www.herber.de/bbs/user/125680.xlsm
AW: Mist! schon wieder der falsche Code ;-))
27.11.2018 18:04:25
Sepp
Hallo Christoph,
ich schrieb: "Außerdem gehe ich davon aus, das in C1 ein 'echtes' Datum steht."
Deine Antwort:"In C1 steht ein echtes Datum, allerdings im Benutzerdefinierten Format von TTMMJJ."
In C1 steht aber die Zahl 271118, das ist kein Datum! Die Zelle ist als Standard formatiert, als Datum würde dort der 17.04.2642 stehen! Als Datum mit 'MMTTJJ' formatiert würde dort 43431 stehen und 271118 angezeigt.
Hier der angepasste Code für deine Zahl die du als Datum interpretierst.
Modul Modul1
Option Explicit 
 
Sub collectData() 
  Dim strFile As String 
  Dim varRet As Variant, varDate As Variant, varValue As Variant, varData As Variant 
  Dim lngRow As Long, lngCol As Long, dblOldTime As Double, dblNewTime As Double 
   
  Const FILEPATH  As String = "D:\Forum\Test\"      'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL  As String = "C1"                  'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
   
  With Sheets("NoShow Zähler") 
    varData = .Range("B4:X34") 
    strFile = Dir(FILEPATH & "*.xls*", vbNormal) 
    Do While strFile <> "" 
      dblNewTime = CDbl(FileDateTime(FILEPATH & strFile)) 
      dblOldTime = dblNewTime 
      With Sheets("Update") 
        varRet = Application.Match(strFile, .Columns(1), 0) 
        If IsNumeric(varRet) Then dblOldTime = .Cells(varRet, 2) 
      End With 
      If IsError(varRet) Or dblNewTime > dblOldTime Then 
        varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL) 
        varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL) 
        If IsNumeric(varDate) Then 
          varDate = DateSerial(Right(varDate, 2), Mid(varDate, 3, 2), Left(varDate, 2)) 
          If Year(varData(1, 1)) = Year(varDate) Then 
            lngCol = Month(varDate) * 2 
            lngRow = Day(varDate) 
            varData(lngRow, lngCol) = varValue 
            With Sheets("Update") 
              If IsNumeric(varRet) Then 
                .Cells(varRet, 2) = dblNewTime 
              Else 
                With .Cells(.Rows.Count, 1).End(xlUp) 
                  .Offset(1, 0) = strFile 
                  .Offset(1, 1) = dblNewTime 
                End With 
              End If 
            End With 
          End If 
        End If 
      End If 
      strFile = Dir 
    Loop 
    .Range("B4:X34") = varData 
  End With 
End Sub 
 
Private Function GetValue(ByVal vFilePath As String, ByVal vFileName As String, ByVal vSheetName As String, ByVal _
  vTargetAddress As String) As Variant 
  Dim Argument As String 
 
  On Error GoTo ErrorHandler 
 
  If Right(vFilePath, 1) <> "\" Then vFilePath = vFilePath & "\" 
  Argument = "'" & vFilePath & "[" & vFileName & "]" & vSheetName & "'!" & _
    Range(vTargetAddress).Range("A1").Address(, , xlR1C1) 
  GetValue = ExecuteExcel4Macro(Argument) 
  Exit Function 
ErrorHandler: 
  GetValue = CVErr(xlErrRef) 
End Function 
 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
27.11.2018 22:15:31
Sepp
Hallo Christoph,
vergiss mein vorheriges Post, das wird nicht funktionieren wenn du einstellige Tages oder Monatszahlen in C1 stehen hast, außerdem wurde im vorherigen Code eine Spalte zu wenig angegeben.
Formatiere die Zelle(n) C1 mit dem Format 'TTMMJJ' und gib das Datum auch als Datum ein, dann diesen Code.
Sub collectData()
  Dim strFile As String
  Dim varRet As Variant, varDate As Variant, varValue As Variant, varData As Variant
  Dim lngRow As Long, lngCol As Long, dblOldTime As Double, dblNewTime As Double
  
  Const FILEPATH  As String = "D:\Forum\Test\"      'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL  As String = "C1"                  'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
  
  With Sheets("NoShow Zähler")
    varData = .Range("B4:Y34")
    strFile = Dir(FILEPATH & "*.xls*", vbNormal)
    Do While strFile <> ""
      dblNewTime = CDbl(FileDateTime(FILEPATH & strFile))
      dblOldTime = dblNewTime
      With Sheets("Update")
        varRet = Application.Match(strFile, .Columns(1), 0)
        If IsNumeric(varRet) Then dblOldTime = .Cells(varRet, 2)
      End With
      If IsError(varRet) Or dblNewTime > dblOldTime Then
        varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL)
        varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL)
        If IsNumeric(varDate) Then
          If Year(varData(1, 1)) = Year(varDate) Then
            lngCol = Month(varDate) * 2
            lngRow = Day(varDate)
            varData(lngRow, lngCol) = varValue
            With Sheets("Update")
              If IsNumeric(varRet) Then
                .Cells(varRet, 2) = dblNewTime
              Else
                With .Cells(.Rows.Count, 1).End(xlUp)
                  .Offset(1, 0) = strFile
                  .Offset(1, 1) = dblNewTime
                End With
              End If
            End With
          End If
        End If
      End If
      strFile = Dir
    Loop
    .Range("B4:Y34") = varData
  End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 07:53:10
Christoph
Hallo Sepp,
bisher stand in "C1" ein richtiges Datum, aber aufgrund der Formatierung des Datums in andere Werte wurde der Datumsbezug in "C2" gelegt, im Code von "C1" auf "C2" geändert. C1 wurde kurzer Hand zur manuellen Eingabe für den Bezug in den Spalten "B" und "O".
Zu dem letzten Code, wenn ich diesen einfüge und das über "Alt&F8" ausführen möchte kommt folgende Fehlermeldung:
"Fehler beim Kompilieren:
Sub oder Function nicht definiert" und geld hinterlegt ist "Sub collectData()"
AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 17:40:44
Sepp
Hallo Christoph,
die Funktion 'getValue()' hast du aber schon im Modul belassen, oder?
Die wird natürlich auch gebraucht.
 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 17:48:26
Christoph
Hallo Sepp,
Der Code wurde so übernommen wie vorgegeben, nur Pfad wurde wieder angepasst. Zusätzliche Änderungen oder Löschungen wurden nicht vorgenommen.
LG
AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 18:04:17
Sepp
Hallo Christoph,
dann weiß ich nicht was du gemacht hast! Lade eine Datei mit dem Code hoch der bei dir den Fehler verursacht.
 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 20:58:46
Sepp
Hallo Christoph,
willst du mich verarschen?
Was hast du an "die Funktion 'getValue()' hast du aber schon im Modul belassen, oder?
Die wird natürlich auch gebraucht."
nicht verstanden? Die Funktion fehlt in deiner Datei!
Du schreibst: "bisher stand in "C1" ein richtiges Datum, aber aufgrund der Formatierung des Datums in andere Werte wurde der Datumsbezug in "C2" gelegt..." im Code hat du aber immer noch C1 stehen!
In deiner Datei ist in 'NoShow Zähler' kein einziges Datum hinterlegt! Wohin bitte, soll der Code die Daten schreiben, zumindest in B4 muss ein Datum stehen, weil mit dieser Zelle das Jahr geprüft wird! Hatte ich schon viel früher geschrieben!
So macht es keinen Spass!
https://www.herber.de/bbs/user/125740.xlsm
 ABCDEF
1Gruß Sepp
2
3

AW: Mist! schon wieder der falsche Code ;-))
28.11.2018 21:19:58
Christoph
Hallo Sepp,
der Code so wie er da Stand war Copy&Paste von deinem Letzten Beitrag. Da ich von zu Hause aus keinen Zugriff auf den benannten Pfad habe und somit nur die "alte" Datei in dem der Bezug noch auf "C1" lasse ich den natürlich im Code unverändert.
Desweiteren hab ich beim erstellen dieser Frage angegeben das Grundkenntnisse in Excel vorhanden sind und nicht das einwandfreier Umgang mit Makros, VBA etc pp. vorhanden ist. Wenn du mich also nach "getValue()' hast du aber schon im Modul belassen, oder?" fragst und ich nichts gelöscht oder verändert habe und diese dann im Code blau markiert wird, gehe ich als Laie davon aus das dies gemeint ist. Und wenn ich es dann lese, dann ist es für mich in diesem Code vorhanden.
Trotzdem Vielen Dank für deine Bemühungen und deine Geduld bis zum vorletzten Post deinerseits.
Thema beendet.
Sorry, Code nicht aktualisiert!
25.11.2018 21:08:38
Sepp
Hallo nochmal,
das ist der richtige Code.
Modul Modul1
Option Explicit 
 
Sub collectData() 
  Dim strFile As String 
  Dim varRet As Variant, varDate As Variant, varValue As Variant 
  Dim lngRow As Long, lngCol As Long 
 
  Const FILEPATH As String = "D:\Forum\Test\"       'Ordner der Quelldateien mit abschließendem Backslash! 
  Const SHEETNAME As String = "Anwesenheitsliste"   'Tabellenname in der Quelldatei. 
  Const DATECELL As String = "C1"                   'Zelle mit dem Datum. 
  Const VALUECELL As String = "O4"                  'Zelle mit dem Wert. 
   
  strFile = Dir(FILEPATH & "*.xls*", vbNormal) 
 
  Do While strFile <> "" 
    varRet = Application.Match(strFile, Sheets("Update").Columns(1), 0) 
    If IsError(varRet) Then 
      With Sheets("Update") 
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = strFile 
      End With 
      varDate = GetValue(FILEPATH, strFile, SHEETNAME, DATECELL) 
      varValue = GetValue(FILEPATH, strFile, SHEETNAME, VALUECELL) 
      If IsNumeric(varDate) Then 
        With Sheets("NoShow Zähler") 
          If Year(.Range("B4")) = Year(varDate) Then 
            lngCol = Month(varDate) * 2 + 1 
            lngRow = Day(varDate) + 3 
            .Cells(lngRow, lngCol) = varValue 
          End If 
        End With 
      End If 
    End If 
    strFile = Dir 
  Loop 
 
End Sub 
 
Private Function GetValue(ByVal Path As String, ByVal File As String, ByVal Sheet As String, ByVal Ref As String) As Variant 
  Dim arg As String 
 
  On Error GoTo ErrorHandler 
 
  If Right(Path, 1) <> "\" Then Path = Path & "\" 
 
  arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref).Range("A1").Address(, , xlR1C1) 
 
  GetValue = ExecuteExcel4Macro(arg) 
 
  Exit Function 
ErrorHandler: 
  GetValue = CVErr(xlErrRef) 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

AW: Sorry, Code nicht aktualisiert!
26.11.2018 07:58:00
Günther
@ Sepp:
1. Endlich mal ein SUPER-Vorbild für vie, die hier Code ohne Einrückungen, etc. posten. (Nur das Blau ist nicht so gut lesbar)
2. Ich bewundere dich wegen deiner ausgesprochen hohen Spendenbereitschfat an die notleidende Industrie ...
AW: Ermunterung
25.11.2018 19:53:55
Fennek
Hallo,
dein Ansatz ist prima!
Das kleine Problem ist, das solche Fragen mehrfach pro Woche gestellt werden und deshalb die Antwortquote sinkt. Es lohnt sich eine Suchmaschine zu nutzen.
Der folgende Code liest Dateien in einem Ordner nur EINMAL ein, könnte also Teil deines Codes werden:

Const Pfad As String = "c:\temp\" '### anpassen ###
Sub Update()
Dim Nm As Name
Dim Bo As Boolean
For Each Nm In ThisWorkbook.Names
If Nm.Name = "Up" Then Bo = True
Next Nm
If Not Bo Then
Names.Add "Up", "_", 0
Names("Up").Comment = CDate("1.1.1900")
End If
f = Dir(Pfad & "*.xls?")
Do While Len(f)
If FileDateTime(Pfad & f) > CDate(Names("Up").Comment) Then
Debug.Print f '##### hier wird später das auslesen der Daten eingefügt ####
End If
f = Dir
Loop
Names("Up").Comment = Now
End Sub

Sub Nm_del() '########### zurück setzen ######
Names("Up").Comment = ""
Names("Up").Delete
End Sub


Das eigentliche Einlesen muss noch programmiert werde, aber da gibt es viele Beispiele im Netz.
mfg
(Debug.Print schreibt ins Direkfenster des VBE)

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige