Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1248to1252
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
Liste mit Excel formel
Steve
Guten Abend,
Ich habe eine tabelle mit 12 Blätter in denen in der Reihe AK4:AK34 einige datums stehen, ich wollte die zusammentragen und in einem blatt alle untereinander auflisten.
Habe es mit verketten versucht aber ohne erfolg.
Habt ihr eine lösung?
Oder habt ihr ein makro der die 12 Blätter automatisch dursucht und in der hauptTabelle auflistet?
Beispiel:
Von test.xlsx von blatt "Hans", "Peter",... die daten ausliest und in der HauptTabelle in blatt "liste" einfügt?
Dachte mir das es besser ist die daten innerhalb der Excel-Tabelle (ohne Makro)zu suchen und erst danach mit einem makro rauskopieren.
Es sind auch mehrere Excel-Files die ich ansprechen muss und da das makro zuerst die Tabellen öffnet koppiert und wieder schliesst, ist der Zeitaufwand ohne zusätzlichem durchsuchen geringer.
Besten Dank für eure hilfe.
Steve

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

Betreff
Benutzer
Anzeige
AW: Liste mit Excel formel
18.02.2012 20:03:55
Josef

Hallo Steve,
da sind schon ein paar Infos mehr nötig.
  • Sollen alle Dateien eines Verzeichnisses eingelesen werden?

  • Sollen die Daten von allen Tabellenblättern dieser Dateien eingelesen werden? Wenn nein, welche Blätter nicht?

  • Wie sind die Tabellenblätter aufgebaut? (Beispieldatei)

  • Soll beim Import der Ausgabebereich zuerst gelöscht werden?



« Gruß Sepp »

Anzeige
AW: Liste mit Excel formel
18.02.2012 20:25:52
Steve
Hallo Sepp,
Hier die antworten:
Ja, alle dateien eines verzeichnisses sollen eingelesen werden.
In der datei sind blätter von Januar bis Dezember, und nur die müssen eingelesen werden, und in AK4 bis AK34 werden feiertags Datum angezeigt. Die sind nicht alt zu viel, Leider :)
An deine letzte antwort denke ich nie, aber ich glaube das währe nicht verkehrt den bereich zuerst zu löschen.
Die Datei ist ziemlich gross, ich mache eine kleien davon.
Danke dir
Steve
AW: Liste mit Excel formel
18.02.2012 20:34:22
Josef

Hallo Steve,
ich brauche nur eine Tabelle aus den Dateien.

« Gruß Sepp »

Anzeige
AW: Liste mit Excel formel
18.02.2012 21:25:22
Josef

Hallo Steve,
teste mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importData()
  Dim objADO As Object
  Dim strPath As String, strFile As String
  Dim vntSheets As Variant
  Dim lngIndex As Long, lngRow As Long
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  vntSheets = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
  
  With ThisWorkbook.Sheets("Liste")
    .Range("A2:A" & .Rows.Count).ClearContents
    strPath = ThisWorkbook.Path & "\Daten\"
    strFile = Dir(strPath & "*.xls*", vbNormal)
    Do While strFile <> ""
      For lngIndex = 0 To UBound(vntSheets)
        lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Set objADO = ExcelTable(strPath & strFile, CStr(vntSheets(lngIndex)), "AK3:AK34")
        .Cells(lngRow, 1).CopyFromRecordset objADO
        objADO.Close
      Next
      strFile = Dir
    Loop
    On Error Resume Next
    .Columns(1).SpecialCells(xlCellTypeBlanks).Delete
    Err.Clear
    On Error GoTo ErrExit
  End With
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'importData'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set objADO = Nothing
End Sub


Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String, Optional WhereString As String = "") As Object
  Dim SQL As String
  Dim Con As String
  
  SQL = "select * from [" & Table & "$" & SourceRange & "] " & WhereString
  
  If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
    Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Extended Properties=Excel 8.0;" _
      & "Data Source=" & Path & ";"
  ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
    Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
      & "Extended Properties=""Excel 12.0;HDR=YES"";" _
      & "Data Source=" & Path & ";"
  Else
    Exit Function
  End If
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
End Function



« Gruß Sepp »

Anzeige
AW: Liste mit Excel formel
18.02.2012 21:40:30
Steve
Hallo Sepp,
funktioniert prächtig, besten Dank.
An eines habe ich aber nicht gedacht, das ich den Namen noch auslesen müsste und vor das datum schreiben. Die stehen normalerweise im blatt vor den Januar (C4 Name und C5 Nachname).
Grusse stephan
AW: Liste mit Excel formel
19.02.2012 10:48:57
Josef

Hallo Stephan,
hat diese Blatt einen fixen Namen? Sonst muss ich einen komplett anderen Code schreiben.

« Gruß Sepp »

Anzeige
Kommando zurück!
19.02.2012 11:00:26
Josef

Hallo Stephan,
der Name steht ja im Dateinamen, dann gehts so.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importData()
  Dim objADO As Object
  Dim strPath As String, strFile As String, strName As String
  Dim vntSheets As Variant
  Dim lngIndex As Long, lngRow As Long, lngCount As Long
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  vntSheets = Array("Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre")
  
  With ThisWorkbook.Sheets("Liste")
    .Range("A2:B" & .Rows.Count).ClearContents
    strPath = ThisWorkbook.Path & "\Test\"
    strFile = Dir(strPath & "*.xls*", vbNormal)
    Do While strFile <> ""
      strName = Trim$(Split(Split(strFile, "-")(1), ".")(0))
      For lngIndex = 0 To UBound(vntSheets)
        lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Set objADO = ExcelTable(strPath & strFile, CStr(vntSheets(lngIndex)), "AK3:AK34")
        lngCount = objADO.RecordCount
        .Cells(lngRow, 2).CopyFromRecordset objADO
        .Range(.Cells(lngRow, 1), .Cells(lngRow + lngCount, 1)) = strName
        objADO.Close
      Next
      strFile = Dir
    Loop
    On Error Resume Next
    .Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Err.Clear
    On Error GoTo ErrExit
  End With
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'importData'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set objADO = Nothing
End Sub


Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String, Optional WhereString As String = "") As Object
  Dim SQL As String
  Dim Con As String
  
  SQL = "select * from [" & Table & "$" & SourceRange & "] " & WhereString
  
  If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
    Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Extended Properties=Excel 8.0;" _
      & "Data Source=" & Path & ";"
  ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
    Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
      & "Extended Properties=""Excel 12.0;HDR=YES"";" _
      & "Data Source=" & Path & ";"
  Else
    Exit Function
  End If
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
End Function



« Gruß Sepp »

Anzeige
AW: Kommando zurück!
19.02.2012 17:25:50
Steve
Hallo Sepp,
Besten Dank, ich versuche es heute abend!
Wie lange hast du gebraucht das Programmieren so gut zu lernen?
Besten Dank nochmal.
Gruss Stephan

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige