Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Liste mit Excel formel | Herbers Excel-Forum


Betrifft: Liste mit Excel formel von: Steve
Geschrieben am: 18.02.2012 19:38:17

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

  

Betrifft: AW: Liste mit Excel formel von: Josef Ehrensberger
Geschrieben am: 18.02.2012 20:03:55


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 »



  

Betrifft: AW: Liste mit Excel formel von: Steve
Geschrieben am: 18.02.2012 20:25:52

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


  

Betrifft: AW: Liste mit Excel formel von: Josef Ehrensberger
Geschrieben am: 18.02.2012 20:34:22


Hallo Steve,

ich brauche nur eine Tabelle aus den Dateien.




« Gruß Sepp »



  

Betrifft: AW: Liste mit Excel formel von: Steve
Geschrieben am: 18.02.2012 21:03:29

Hallo Sepp,

Hier di datei

https://www.herber.de/bbs/user/78988.xlsx

Die dateiendungen sind alle in diesem format (100 - Hans Meier.xlsx).

Gruss Steve


  

Betrifft: AW: Liste mit Excel formel von: Josef Ehrensberger
Geschrieben am: 18.02.2012 21:25:22


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 »



  

Betrifft: AW: Liste mit Excel formel von: Steve
Geschrieben am: 18.02.2012 21:40:30

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


  

Betrifft: AW: Liste mit Excel formel von: Josef Ehrensberger
Geschrieben am: 19.02.2012 10:48:57


Hallo Stephan,

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




« Gruß Sepp »



  

Betrifft: Kommando zurück! von: Josef Ehrensberger
Geschrieben am: 19.02.2012 11:00:26


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 »



  

Betrifft: AW: Kommando zurück! von: Steve
Geschrieben am: 19.02.2012 17:25:50

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


Beiträge aus den Excel-Beispielen zum Thema "Liste mit Excel formel"