Thema Datum  Von Nutzer Rating
Antwort
02.05.2014 11:09:57 pBrue
Solved
02.05.2014 13:47:02 Amicro2000
NotSolved
02.05.2014 18:37:17 Gast15019
NotSolved
02.05.2014 19:25:43 Gast20374
NotSolved
02.05.2014 19:32:18 Gast16797
NotSolved
02.05.2014 20:11:39 Gast96180
NotSolved
Rot Suchen und auslesen bestimmter Daten aus vielen Excel-Listen mit Makro
 02.05.2014 20:39:39 Amicro2000
NotSolved
02.05.2014 20:45:33 Gast10650
NotSolved
02.05.2014 20:42:04 Gast51900
NotSolved

Ansicht des Beitrags:
Von:
Amicro2000		 Datum:
02.05.2014 20:39:39		 Views:
821		 Rating:
     
Antwort:
  Ja
Thema:
Suchen und auslesen bestimmter Daten aus vielen Excel-Listen mit Makro

Hallo wieder pBrue,

 

Probiere es mal so:

 

Private WS As Object

Sub Pfadmakro()
    Dim cDir As String
    Dim sPath As String
    Dim arrSuche As Variant
    Dim i As Long
    Dim lRow As Long
    Dim lcolumn As Long
    Dim WB As Workbook
    Dim TS As Worksheet
    
    sPath = "C:\Zielordner\"
    arrSuche = Array("Vorwahl", "Position", "Rufnummer", "Name")
    cDir = Dir(sPath & "*.xlsx")
    
    ' Überschriften in zeile 1 schreiben
    Set TS = ThisWorkbook.Worksheets("Tabelle1")
    
    Application.ScreenUpdating = False
    
    lRow = lRow + 1
    TS.Cells(lRow, 1) = "Dateiname"
    For i = LBound(arrSuche) To UBound(arrSuche)
        TS.Cells(lRow, i + 2) = arrSuche(i)
    Next i
    
    Do While cDir <> ""
        Set WB = Workbooks.Open(sPath & cDir) 'öffnet die Datei
        Set WS = WB.Worksheets("Tabelle1")
        
        lRow = lRow + 1
        TS.Cells(lRow, 1) = cDir
        For i = LBound(arrSuche) To UBound(arrSuche)
            TS.Cells(lRow, i + 2) = Suche(arrSuche(i))
        Next i

        WB.Close savechanges:=False
   
        cDir = Dir 'nächste Datei lesen
    Loop
    
    Application.ScreenUpdating = True
End Sub
 
Function Suche(ByVal strSuche As String) As String
    Dim Zelle As Range
    
    Set Zelle = WS.Rows(1).Find(What:=strSuche, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Zelle Is Nothing Then
        Suche = Zelle.Offset(1, 0).Text
    End If
End Function

Gruß Amicro

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
02.05.2014 11:09:57 pBrue
Solved
02.05.2014 13:47:02 Amicro2000
NotSolved
02.05.2014 18:37:17 Gast15019
NotSolved
02.05.2014 19:25:43 Gast20374
NotSolved
02.05.2014 19:32:18 Gast16797
NotSolved
02.05.2014 20:11:39 Gast96180
NotSolved
Rot Suchen und auslesen bestimmter Daten aus vielen Excel-Listen mit Makro
 02.05.2014 20:39:39 Amicro2000
NotSolved
02.05.2014 20:45:33 Gast10650
NotSolved
02.05.2014 20:42:04 Gast51900
NotSolved