Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Excel Dateien durchsuchen und Werte in neue Excel Datei auslesen

Mitglied: Arafat

Arafat (Level 1) - Jetzt verbinden

03.11.2006, aktualisiert 18.10.2012, 55977 Aufrufe, 33 Kommentare

Hallo und Danke für Eure stets guten Antworten und Hilfen!

Folgendes Problem habe ich:

WinXP - Office2003

Ich habe etliche Excel Dateien mit je einem Tabellenblatt - in diesen Dateien stehen ähnliche Daten (Name, Vorname, etc.) leider aber nicht in in gleichen Felden (mal ist Name auf A1 der "Wert" dazu auf B1 - mal auf A2 und B2). Ich möchte nun alle Dateien durchsuchen und die "Werte" in eine neue Excel Datei auslesen lassen.

Ich denke ich komme nicht an Makros vorbei - die sind aber leider garnicht meine Welt - vielleicht gibts ja auch ne Möglichkeit das ganze als Shell-Script zu machen.

Vielleich Dank für Eure ANtworten

Gruß MArkus
33 Antworten
Mitglied: bastla
03.11.2006 um 10:50 Uhr
Hallo Markus!

Um das Ganze automatisieren zu können, wären zusätzliche Informationen ganz gut:

Gibt es eine Systematik bei den Dateinamen?
Falls nein: Wie viele sind "etliche"? (Hintergrund: Ist es praktikabel, alle Dateien gleichzeitig zu öffnen?)
Habe ich richtig verstanden, dass jeweils der Inhalt einer Zelle ("Wert"), die rechts neben einer Zelle mit gleich bleibendem Inhalt (also "Name" ist in allen Tabellen vollkommen identisch) steht, übernommen werden soll?
Kommt der "Name" in jeder Mappe bzw Tabelle nur einmal bzw nur in Spalte A vor?
Die übernommenen "Werte" sollen vermutlich in der Zieltabelle in einer Spalte untereinander gespeichert werden?

Grüße
bastla
Bitte warten ..
Mitglied: Arafat
03.11.2006 um 11:21 Uhr
ok - etwas mehr ins Detail:

1. es sind zwischen 500 und 1000 Dateien
2. in diesen Dateien stehen die "Werte" in Spalte B - die Wertebezeichnunge (Name, Vorname...) in Spalte A - die Werte an sich kommen nur einmal in jeder Datei vor

in der Ziel Datei sollen nur noch die Werte vorkommen -

Beispiel:

Quelle:

Datei 1
A : B
Name : Meier
Vorname : Hans
Strasse : Wesergraben

Datei 2
A : B
Vorname : Jupp
Name : Heinckes
Strasse: im Niergendwo



Ziel:

A : B : C
Hans : Meier : Wesergraben
Jupp : Heinckes : im Niergendwo


so in etwa sieht es vom Prinzip her aus - natürlich etwas komplexer

Gruß Markus
Bitte warten ..
Mitglied: Arafat
03.11.2006 um 11:22 Uhr
noch was - eine Systematik in den Dateinamen gibt es nicht - leider - aber man könnte sie alle in ein Verzeichnis kopieren - so das der Aufenthalt der gleiche ist
Bitte warten ..
Mitglied: Arafat
03.11.2006 um 11:52 Uhr
also eigentlich würde mir vielleicht schon die Möglichkeit reichen aus - verschiedenen excel dateien eine CSV-Datei zu machen - diese könnte ich per awk-skript bearbeiten - da kenn ich mich dann aus
Bitte warten ..
Mitglied: bastla
03.11.2006 um 12:20 Uhr
Hallo Markus!

Alle Dateien in einem Ordner genügt.

Erstelle die Zieldatei (in meinem Beispiel mit dem Namen "Alle.xls") in einem anderen Ordner und füge folgendes Makro hinzu:

01.
Option Explicit
02.
 
03.
Sub GetData()
04.
 
05.
Dim oMe As Object
06.
Set oMe = Workbooks("Alle.xls").Worksheets("Tabelle1") 'ZielDatei/-Tabelle (also die gerade geöffnete) ;-)
07.
Const sDateiPfad As String = "D:\Test\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
08.
Const iSbAnzahl = 3 'Nach 3 Begriffen suchen
09.
Dim sSuchbegriff(iSbAnzahl) As String
10.
sSuchbegriff(1) = "Name"
11.
sSuchbegriff(2) = "Vorname"
12.
sSuchbegriff(3) = "Strasse"
13.
 
14.
Dim i As Integer
15.
Dim sWbName As String
16.
Dim rFound As Range
17.
Dim vWert As Variant
18.
Dim iZeile As Integer
19.
 
20.
iZeile = 2
21.
Dim oFS As Object, oDatei As Object
22.
Set oFS = CreateObject("Scripting.FileSystemObject")
23.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
24.
    sWbName = oDatei.Name
25.
    Workbooks.Open (sDateiPfad & sWbName)
26.
    For i = 1 To iSbAnzahl
27.
        Set rFound = Workbooks(sWbName).Worksheets(1).Range("a1:a100").Find(sSuchbegriff(i), LookIn:=xlValues)
28.
        If Not rFound Is Nothing Then
29.
            vWert = Cells(rFound.Row, rFound.Column + 1).Value
30.
            oMe.Cells(iZeile, i).Value = vWert
31.
        End If
32.
    Next
33.
    Workbooks(sWbName).Saved = True
34.
    Workbooks(sWbName).Close
35.
    iZeile = iZeile + 1
36.
Next
37.
End Sub
Anzupassen sind die Daten im ersten Absatz sowie weiter unten der vorgegebene Suchbereich Range("a1:a100").

Nach Durchlauf des Makros (vielleicht nur einmal mit 3 Dateien testen ) enthält die Zieldatei die entsprechenden Einträge und kann (in beliebigem Format, auch csv) gespeichert werden (wird nicht durch das Makro erledigt).

HTH
bastla
Bitte warten ..
Mitglied: Arafat
03.11.2006 um 12:32 Uhr
Danke - genau das ist es !!!
Bitte warten ..
Mitglied: Sleepy00
09.07.2007 um 10:14 Uhr
Hey Ihr beiden!

Habe ein so ähnliches Problem, jedoch mit etwas geänderten Variablen. Würde jedoch gerne diese VBA-Grundstruktur verwenden, jedoch funktioniert dies nicht so bei mir wie erwartet.

Könntet Ihr deshalb das Excel-Sheet uploaden oder so, dass ich mir ein bild davon machen kann wie es geht?

ware nett

thx, im voraus
rene
Bitte warten ..
Mitglied: bastla
09.07.2007, aktualisiert 18.10.2012
Hallo Sleepy00 und willkommen im Forum!

"Das Excel-Sheet" gibt es eigentlich nicht, sondern es ist, wie oben beschrieben, zu erstellen.

Wenn Du Dein Vorhaben etwas näher erklärst, sollten wir hoffentlich auch unter geänderten Voraussetzungen etwas Brauchbares basteln können ...

Grüße
bastla
Bitte warten ..
Mitglied: BTS-18203
03.03.2008 um 00:01 Uhr
Hallo,

ich nehme das Thema und das oben geschriebene Makro nochmal auf, da es im Grunde meine Bedürfnisse beinahe trifft und toll funktioniert.

Möchte aus mehreren Excel-Dateien Werte in einer Datei zusammenfassen (wie Arafat). Die Variation besteht aber darin, dass die einzelnen Excel-Dateien eine variierende Anzahl von Tabellenblättern beinhalten, und von diesen sollen auch nur bestimmte Tabellenblätter bei der Zusammenfassung berücksichtigt werden.

Bsp.: In dem Ordner D:\Test\ liegen 2 Excel-Dateien.
Die erste hat 21 Tabellenblätter, wovon ein Tabellenblatt eine Übersicht ist ('Übersicht'), 20 Tabellenblätter sind Testauswertungen ('Test 1' bis 'Test 20').
Die zweite hat 16 Tabellenblätter, auch hier eine Übersicht und 15 Testauswertungen ('Test 1' bis 'Test 15').

Ziel des Makros ist es wie bei Arafat, bestimmte Werte aus den Dateien in einer neuen Liste zusammenzuführen. Hierbei sollen aber nur Werte von Tabellenblättern berücksichtigt werden, deren Bezeichnung mit 'Test' beginnen.

Könnt Ihr mir bei der Anpassung des Makros helfen??
Bitte warten ..
Mitglied: bastla
03.03.2008 um 14:20 Uhr
Hallo BTS-18203 und willkommen im Forum!

Mit kleineren Änderungen (zB muss die Sammeldatei nicht mehr "Alle.xls" heißen, sollte sich aber dennoch nicht im selben Ordner wie die zu durchsuchenden Dateien befinden) und der gewünschten Ergänzung (Berücksichtigung aller passenden Blätter der einzelnen Tabellen) sollte es so gehen:
01.
Option Explicit
02.
 
03.
Sub GetData()
04.
 
05.
Dim oMe As Object, sSuchbegriff(), sBereich As String, iZeile As Integer, sKennz As String
06.
Dim iSbMax As Integer, iLK As Integer, i As Integer, sWbName As String, rFound As Range, vWert As Variant
07.
Dim oFS As Object, oDatei As Object, wsTabelle As Worksheet, bEintrag As Boolean
08.
 
09.
Set oMe = ThisWorkbook.Worksheets("Tabelle1") 'Zieltabelle (in der gerade geöffneten Datei)
10.
iZeile = 2 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen
11.
Const sDateiPfad As String = "D:\Test\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
12.
sKennz = "Test" 'Nur Tabellen, deren Name mit dem Kennzeichen beginnt, verarbeiten
13.
sSuchbegriff = Array("Name", "Vorname", "Strasse") 'Liste der Suchbegriffe
14.
sBereich = "A1:A100"
15.
 
16.
iSbMax = UBound(sSuchbegriff) 'Höchster Index der Suchbegriffmatrix
17.
iLK = Len(sKennz) 'Länge des Tabellennamen-Kennzeichens
18.
 
19.
Set oFS = CreateObject("Scripting.FileSystemObject")
20.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
21.
    sWbName = oDatei.Name
22.
    Workbooks.Open (oDatei.Path)
23.
    For Each wsTabelle In Workbooks(sWbName).Worksheets()
24.
        If StrComp(Left(wsTabelle.Name, iLK), sKennz, vbTextCompare) = 0 Then
25.
            bEintrag = False
26.
            For i = 0 To iSbMax
27.
                Set rFound = wsTabelle.Range(sBereich).Find(sSuchbegriff(i), LookIn:=xlValues)
28.
                If Not rFound Is Nothing Then
29.
                    vWert = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
30.
                    oMe.Cells(iZeile, i + 1).Value = vWert
31.
                    bEintrag = True
32.
                End If
33.
            Next
34.
            If bEintrag Then iZeile = iZeile + 1 'mindestens ein Eintrag erfolgt, daher neue Zeile
35.
        End If
36.
    Next
37.
    Workbooks(sWbName).Saved = True
38.
    Workbooks(sWbName).Close
39.
Next
40.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: BTS-18203
04.03.2008 um 18:57 Uhr
Phantastisch,

ausprobiert und für gut geheisen. So schön kann Excel sein, vielen Dank für die Hilfe.

Beste Grüße
BTS_18203
Bitte warten ..
Mitglied: BTS-18203
08.04.2008 um 17:58 Uhr
Ich würde das Makros gerne auch für eine andere Sache verwenden, bekomme die Abwandlung jedoch nicht hin.

Ist-Zustand: Ich erhalte täglich 12-20 Excel-Listen mit Leistungswerten, die ich gerne in einer Datei zusammenfassen würde und ggf. in eine Access Datei exportieren würde. In den Dateien sind die Leistungen von einzelnen Mitarbeitern in Verschiedenen Themen (Vertriebskanäle) aufgeführt. Im Grunde ist der Aufbau der Datein identisch, es werden jedoch von den 8 möglichen Vertriebskanäle nur die aufgeführt, in denen die Mitarbeiter auch gearbeitet haben. D.h. die Werte eines Vertriebskanals sind nicht immer in der gleichen Spalte aufgeführt.

Beispiele:
[Dateiname: Datei 1]
Namen Vertriebskanal1 Vertriebskanal2 Vertriebskanal3
ADAM 15 10 20
BIRGIT 10 0 15

[Dateiname: Datei 2]
Namen Vertriebskanal1 Vertriebskanal3
CÄSAR 5 8
DETLEF 20 0

Ziel ist es, aus den einzelnen Dateien, die täglich in einem definierten Laufwerksordner abgelegt werden, eine Datei zu machen, mit der dann weiter gearbeitet werden kann.

Ziel Beispiel:

Dateiname Name Vertriebskanal Leistung
Datei 1 ADAM Vertriebskanal 1 15
Datei 1 ADAM Vertriebskanal 2 10
Datei 1 ADAM Vertriebskanal 3 20
Datei 1 BIRGIT Vertriebskanal 1 10
Datei 1 BIRGIT Vertriebskanal 3 15
Datei 2 CÄSAR Vertriebskanal 1 5
Datei 2 CÄSAR Vertriebskanal 3 8
Datei 2 DETLEF Vertriebskanal 1 20


Könnt Ihr mir bei der Abwandlung des o.g. Makros helfen?

Beste Grüße
BTS-18203
Bitte warten ..
Mitglied: bastla
08.04.2008 um 22:09 Uhr
Hallo BTS-18203!

Soferne es zwischen den Daten keine Leerzeilen bzw -spalten gibt, sollte es so gehen:
01.
Option Explicit
02.
 
03.
Sub GetData()
04.
 
05.
Dim oMe As Object, sUeber() As String, sVK()
06.
Dim iZSpalte As Integer, iZZeile As Integer, iZAbZeile As Integer, iZAbSpalte As Integer, iZSpAnz As Integer
07.
Dim iQZeile As Integer, iQSpalte As Integer, iQAbZeile As Integer, iQAbSpalte As Integer, iQSpAnz As Integer
08.
Dim sWbName As String, sName As String, sV As Variant, iLeist As Integer
09.
 
10.
 
11.
'######## ab hier anpassen ########
12.
Set oMe = ThisWorkbook.Worksheets("Tabelle1") 'Zieltabelle (in der gerade geöffneten Datei)
13.
Const sDateiPfad As String = "D:\Test\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
14.
 
15.
sUeber = Split("Dateiname Name Vertriebskanal Leistung") 'Spaltenüberschriften
16.
iZAbSpalte = 1 'ab dieser Spalte Ergebnisse in die Zieltabelle eintragen
17.
iZAbZeile = 1 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen (Spaltenüberschriften; Leerzeichen als Trennzeichen)
18.
 
19.
iQAbSpalte = 1 'ab dieser Spalte Daten in Quelltabelle enthalten
20.
iQAbZeile = 1 'ab dieser Zeile Daten in Quelltabelle enthalten
21.
'######## bis hier anpassen ########
22.
 
23.
 
24.
iZSpAnz = UBound(sUeber)
25.
With oMe
26.
    .Cells.Clear 'gesamte Zieltabelle löschen
27.
    .Range(.Cells(iZAbZeile, iZAbSpalte), .Cells(iZAbZeile, iZAbSpalte + iZSpAnz)).Value = sUeber 'Überschriften eintragen
28.
End With
29.
iZZeile = iZAbZeile + 1
30.
 
31.
Dim oFS As Object, oDatei As Object
32.
Set oFS = CreateObject("Scripting.FileSystemObject")
33.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
34.
    sWbName = oDatei.Name
35.
    Workbooks.Open (sDateiPfad & sWbName)
36.
    With Workbooks(sWbName).Worksheets(1)
37.
        iQSpalte = iQAbSpalte + 1 'Vertriebskanäle ab dieser Spalte
38.
        iQZeile = iQAbZeile 'Überschriften ab dieser Zeile
39.
        Do While .Cells(iQZeile, iQSpalte).Value <> ""
40.
            iQSpalte = iQSpalte + 1
41.
        Loop
42.
        iQSpAnz = iQSpalte - iQAbSpalte - 1
43.
                
44.
        sVK = .Range(.Cells(iQAbZeile, iQAbSpalte + 1), .Cells(iQAbZeile, iQAbSpalte + iQSpAnz)).Value
45.
        
46.
        iQZeile = iQZeile + 1
47.
        iQSpalte = iQAbSpalte
48.
        
49.
        Do While .Cells(iQZeile, iQAbSpalte).Value <> ""
50.
            iQSpalte = iQAbSpalte
51.
            sName = .Cells(iQZeile, iQSpalte).Value
52.
            For Each sV In sVK
53.
                iQSpalte = iQSpalte + 1
54.
                iLeist = .Cells(iQZeile, iQSpalte).Value
55.
                With oMe
56.
                    'Eintragung in Zieltabelle; Reihenfolge siehe Überschriften (sUeber)
57.
                    .Cells(iZZeile, iZAbSpalte).Value = sWbName
58.
                    .Cells(iZZeile, iZAbSpalte + 1).Value = sName
59.
                    .Cells(iZZeile, iZAbSpalte + 2).Value = sV
60.
                    .Cells(iZZeile, iZAbSpalte + 3).Value = iLeist
61.
                    iZZeile = iZZeile + 1
62.
                End With
63.
            Next
64.
            iQZeile = iQZeile + 1
65.
        Loop
66.
    End With
67.
    
68.
    Workbooks(sWbName).Saved = True
69.
    Workbooks(sWbName).Close
70.
    
71.
Next
72.
 
73.
'Sortierung: zunächst (Key1) nach Datei, dann (Key2)nach Name
74.
With oMe
75.
.Cells(iZAbZeile, iZAbSpalte).Sort _
76.
    Key1:=.Cells(iZAbZeile, iZAbSpalte), Order1:=xlAscending, _
77.
    Key2:=.Cells(iZAbZeile, iZAbSpalte + 1), Order2:=xlAscending, _
78.
    Header:=xlYes, OrderCustom:=1, Orientation:=xlTopToBottom
79.
End With
80.
End Sub
Auch in diesem Fall sollte sich die Zieldatei nicht im selben Ordner wie die Quelldateien befinden.

Die Zieltabelle wird zu Beginn vollständig gelöscht und abschließend nach Datei und Name sortiert.

Grüße
bastla
Bitte warten ..
Mitglied: warnickel
07.07.2008 um 09:15 Uhr
hallo bastla,
ich weiß nicht was ich falsch mache, aber ich versuche es zur zeit mit deinem zweiten skript und es wird zwar durchgeführt, doch es erscheinen keine Namen, etc. bei mir in der Tabelle, was mache ich falsch?

Ich habe meine Dateien alles gleich benannt, einen ordner für die fragebögen geschaffen, jedoch durch sucht er zwar aber er schreibt nichts in die Zieltabelle?

Viele Grüße,
Warnickel
Bitte warten ..
Mitglied: vzimmer
10.10.2011 um 14:27 Uhr
Hallo,

ich würde das Makro gerne ähnlich verwenden, bekomme aber die Anpassung für meine Zwecke nicht hin.

Ich habe mehrere Dateien mit jeweils mehreren Tabellenblättern, die ausgelesen werden sollen und deren Daten in eine Zieldatei übertragen werden sollen.

Das ganze soll mit einem Suchbegriff geschehen, aber je nach Suchbegriff sollen in Relation zum Suchbegriff unterschiedliche Zellen ausgelesen werden.

Bsp. Suchbegriff Name => +1 Spalte rechts soll ausgegeben werden
Bsp. Suchbegriff Auszahlunt Monatsprämie 1 => +1 Zeile darunter soll ausgegeben werden
Bsp. Suchbegriff Zielerreichung MP 1 => + 1 Spalte rechts soll ausggegeben werden
Bsp. Suchbegriff Jan 11 => + Spalte 1-7 rechts davon sollen ausgegeben werden

D.h. ich muss irgendwie für jeden Suchbegriff definieren können, welcher Wert ausgegeben werden soll, dieser soll dann in der Zieldatei jeweils in die Spalte daneben geschrieben werden und die Daten aus dem nächsten Tabellenblatt in einer neuen Zeile etc.

Ich kenn mich mit Makros nicht so gut aus, ein paar kleinere Anpassungen hab ich zwar geschafft, aber jetzt häng ich.
Anbei mein (fehlerhafter) Versuch:

01.
Sub GetData()
02.
 
03.
Dim oMe As Object, sBereich As String, iZeile As Integer, iSpalte As Integer, sKennz As String
04.
Dim i As Integer, sWbName As String, rFound As Range
05.
Dim vName As Variant, vVorname As Variant, vBU As Variant, vAbteilung As Variant, vMPK1 As Variant, vMPK2 As Variant, vMPK3 As Variant
06.
Dim oFS As Object, oDatei As Object, wsTabelle As Worksheet, bEintrag As Boolean
07.
 
08.
Set oMe = ThisWorkbook.Worksheets("Tabelle1") 'Zieltabelle (in der gerade geöffneten Datei)
09.
 
10.
iZeile = 4 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen
11.
iSpalte = 1
12.
 
13.
Const sDateiPfad As String = "H:\Eigene Dateien\Dateienauslesen\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
14.
Const iSbAnzahl = 7 'Nach x Begriffen suchen
15.
Dim sSuchbegriff(iSbAnzahl) As String
16.
sSuchbegriff(1) = "Name:"
17.
sSuchbegriff(2) = "Vorname:"
18.
sSuchbegriff(3) = "BU:"
19.
sSuchbegriff(4) = "Abteilung:"
20.
sSuchbegriff(5) = "Auszahlung Monatspraemie 1"
21.
sSuchbegriff(6) = "Auszahlung Monatspraemie 2"
22.
sSuchbegriff(7) = "Auszahlung Monatspraemie 3"
23.
sBereich = "A1:Z200"
24.
 
25.
Set oFS = CreateObject("Scripting.FileSystemObject")
26.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
27.
    sWbName = oDatei.Name
28.
    Workbooks.Open (oDatei.Path), Password:="pw", WriteResPassword:="pw"
29.
    For Each wsTabelle In Workbooks(sWbName).Worksheets()
30.
            For i = 0 To iSbAnzahl
31.
                Set rFound = wsTabelle.Range(sBereich).Find(sSuchbegriff(i), LookIn:=xlValues)
32.
                If Not rFound Is Nothing Then
33.
                    vWert = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
34.
                    vVorname = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
35.
                    vBU = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
36.
                    vAbteilung = wsTabelle.Cells(rFound.Row, rFound.Column + 1).Value
37.
                    vMPK1 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
38.
                    vMPK2 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
39.
                    vMPK3 = wsTabelle.Cells(rFound.Row + 1, rFound.Column).Value
40.
                    With oMe
41.
                    .Cells(iZeile, i + 1).Value = vName
42.
                    .Cells(iZeile, i + 2).Value = vVorname
43.
                    .Cells(iZeile, i + 3).Value = vBU
44.
                    .Cells(iZeile, i + 4).Value = vAbteilung
45.
                    .Cells(iZeile, i + 5).Value = vMPK1
46.
                    .Cells(iZeile, i + 6).Value = vMPK2
47.
                    .Cells(iZeile, i + 7).Value = vMPK3
48.
                    bEintrag = True
49.
                    End With
50.
                End If
51.
            Next
52.
            If bEintrag Then iZeile = iZeile + 1 'mindestens ein Eintrag erfolgt, daher neue Zeile
53.
    Next
54.
    Workbooks(sWbName).Saved = True
55.
    Workbooks(sWbName).Close
56.
Next
57.
End Sub
Danke für Eure Hilfe!

Vicky
Bitte warten ..
Mitglied: utroger
22.02.2012 um 10:45 Uhr
Hallo zusammen, bin neu hier, habe ein ähnliches Problem und habe schon alles durchsucht aber nichts passendes gefunden.
Also benutze Excel 2007
habe in einem Verzeichnis lauter Exceldateien stehen, aus diesen Dateien soll immer das Feld H5 in eine neue Tabelle ausgelsen werden und im nächsten feld ein Hyperlink erscheinen so das ich die Datei bei bedarf von dort öffnen kann. Das Feld H5 entält einen Index der für mich die Information ist ob aktuell oder nicht.
Im Moment muss ich jede einzelne Datei öffnen was absolut nervig ist bei ca .500 einzelnen Dateien.

Wäre schön für ein Beispiel wie ich das lösen könnte.

Im Voraus Danke
Bitte warten ..
Mitglied: bastla
22.02.2012 um 12:31 Uhr
Hallo utroger und willkommen im Forum!

Sollte sich etwa so machen lassen:
01.
Sub GetData()
02.
 
03.
Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen Datei)
04.
Const sDateiPfad As String = "D:\Test\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
05.
 
06.
sZelle = "H5" 'auszulesende Zelle
07.
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
08.
iSpalte = 1 'ab Spalte A in Zieltabelle eintragen
09.
 
10.
Set oFS = CreateObject("Scripting.FileSystemObject")
11.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
12.
    sWbName = oDatei.Name
13.
    If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
14.
        Workbooks.Open (sDateiPfad & sWbName)
15.
        oMe.Cells(iZeile, iSpalte).Value = Range(sZelle).Value
16.
        oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 1), Address:=sDateiPfad & sWbName, TextToDisplay:=sWbName
17.
        Workbooks(sWbName).Saved = True
18.
        Workbooks(sWbName).Close
19.
        iZeile = iZeile + 1
20.
    End If
21.
Next
22.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: utroger
27.02.2012 um 07:59 Uhr
erstmal Danke für die Antwort bastla.
Den Hyperlink setzt er in das Tabellenblatt aber in Spalte A wird kein Index aus den auszulesenden Dateien eingetragen.
Also Spalte B steht der Hyperlink und Spalte A bleibt leer wo der Index stehen sollte.

Diese Zeile im Code verstehe ich doch richtig?

Workbooks.Open (sDateiPfad & sWbName)
oMe.Cells(iZeile, iSpalte).Value = Range(sZelle).Value

Also es soll die Datei geöffnet werden, sZelle wäre in diesem Fall Feld H5 und in neue Tabelle vor dem Hyperlink eingetragen werden.

nur er macht es nicht.

würde mich freuen über ein Rückantwort und noch mal DANKE im Voraus.

Grüße
utroger
Bitte warten ..
Mitglied: bastla
27.02.2012 um 12:11 Uhr
Hallo utroger!

Die beiden Code-Zeilen hast Du richtig interpretiert ...

Verwende ersatzweise folgende Zeile 15:
        oMe.Cells(iZeile, iSpalte).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle).Value
Grüße
bastla
Bitte warten ..
Mitglied: utroger
27.02.2012 um 12:37 Uhr
hallo bastla,

super, funktioniert !

Nochmals besten Danke für die schnelle Hilfe

Grüße utroger
Bitte warten ..
Mitglied: utroger
27.02.2012 um 14:38 Uhr
Hallo basla,

wollte nun noch das Feld D5 mit auslesen.
Habe gedacht ich könnte mir den Rest selbst zusammenfügen, habe mich wohl überschätzt.
Er macht das zwar in dem ich den code ein zeitesmal mit aufgenommen habe, aber ich denke das geht noch besser ohne das das Feld "D5" als Hyperlink mit ausgegeben wird und zweimal der Code durchlaufen muss.

hier mal den Code den ich nicht "professionell aber funktioniert" umgestellt habe.
Was bestimmt ein lächeln bei Dir ausführen wird.

Sub GetData()

Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen Datei)
Const sDateiPfad As String = "G:\QW_Control-Range\Bauteile\DW8000_Range\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende

sZelle = "H5" 'auszulesende Zelle
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
iSpalte = 1 'ab Spalte A in Zieltabelle eintragen


Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
sWbName = oDatei.Name
If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
Workbooks.Open (sDateiPfad & sWbName)
oMe.Cells(iZeile, iSpalte).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle).Value
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 1), Address:=sDateiPfad & sWbName, TextToDisplay:=sWbName
Workbooks(sWbName).Saved = True
Workbooks(sWbName).Close
iZeile = iZeile + 1
End If
Next
sZelle = "D5" 'auszulesende Zelle
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
iSpalte = 2 'ab Spalte A in Zieltabelle eintragen


Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
sWbName = oDatei.Name
If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
Workbooks.Open (sDateiPfad & sWbName)
oMe.Cells(iZeile, iSpalte).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle).Value
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 1), Address:=sDateiPfad & sWbName, TextToDisplay:=sWbName
Workbooks(sWbName).Saved = True
Workbooks(sWbName).Close
iZeile = iZeile + 1
End If
Next
End Sub


Eilt nicht, aber ich würde Dankbar sein für eine professionelle Lösung

Grüße utroger
Bitte warten ..
Mitglied: bastla
27.02.2012 um 15:47 Uhr
Hallo utroger!

Sollte eher so aussehen:
01.
Sub GetData()
02.
 
03.
Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen Datei)
04.
Const sDateiPfad As String = "D:\Test\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
05.
 
06.
sZelle1 = "H5" 'auszulesende Zelle
07.
sZelle2 = "D5" 'weitere auszulesende Zelle
08.
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
09.
iSpalte = 1 'ab Spalte A in Zieltabelle eintragen
10.
 
11.
Set oFS = CreateObject("Scripting.FileSystemObject")
12.
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
13.
    sWbName = oDatei.Name
14.
    If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
15.
        Workbooks.Open (sDateiPfad & sWbName)
16.
        oMe.Cells(iZeile, iSpalte).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle1).Value
17.
        oMe.Cells(iZeile, iSpalte + 1).Value = Workbooks(sWbName).ActiveSheet.Range(sZelle2).Value
18.
        oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 2), Address:=sDateiPfad & sWbName, TextToDisplay:=sWbName
19.
        Workbooks(sWbName).Saved = True
20.
        Workbooks(sWbName).Close
21.
        iZeile = iZeile + 1
22.
    End If
23.
Next
24.
End Sub
Bei noch mehr zu übernehmenden Zellen würde sich dann eine eigene Schleife anbieten ...

Grüße
bastla
Bitte warten ..
Mitglied: utroger
28.02.2012 um 07:14 Uhr
Hallo bastla,

herzlichen Dank, funktioniert.
So gut und vorallem so schnell hatte ich noch nie Hilfe erhalten, SUPER.

Grüße
utroger
Bitte warten ..
Mitglied: hansfrans
18.05.2012 um 22:46 Uhr
Hallo zusammen,

mein Problem geht vermutlich auch in die Richtung, deshalb häng ichs hier dran.

Die Quelldatei enthält 3 Spalten (Vokabelnummer "NR", deutsches Wort "GER", englische Übersetzung "ENG"). In der Zieldatei befinden sich nur noch die Überschriften "NR" und "ENG", wobei "NR" (mehrere Zeilen) bereits vorgegeben sind und als Suchkriterium dienen! Das Makro soll nun mit Hilfe dieser Vorgaben die Quelldatei durchsuchen und die entsprechenden Felder (ENG) übertragen.

Zur Veranschaulichung:
http://www25.zippyshare.com/v/10032778/file.html

Danke!
Bitte warten ..
Mitglied: bastla
18.05.2012 um 22:51 Uhr
Hallo hansfrans und willkommen im Forum!

Das wäre in diesem Fall doch einfach per "SVERWEIS()" zu realisieren ...

Grüße
bastla
Bitte warten ..
Mitglied: Ano-Oobist
12.04.2013 um 15:26 Uhr
Hallo,
das Thema passt genau in meine Richtung und ich frage an nach Details für mein spezifisches Problem.

Danke für die bisher super Erklärung und Vorlage für ein eigenes Makro.

Das Makro funktioniert soweit erstmal für Zellen mit einfachen Inhalten. Ich muss es nun weiter anpassen. Dazu meine Fragen:

- Was muss ich statt "sZelle" eintragen, wenn ich zusammenhängende Felder habe? Feld T38 bis X38 z.B.

- Teilweise sind die Felder mit SVERWEISEN. Wie kann ich einstellen, dass nur der Text kopiert wird? Müller statt SVERWEIS(....)

Letzte Frage noch zum Ablauf.

Wie kann ich einstellen, dass nicht alle Dateien neu reinkopiert werden, sondern nur noch neue? Manuell kann ich das so machen, dass im Ordner die alten gelöscht werden, aber denke, dass es vom Makro her auch gehen sollte, oder?

Wenn ich das Makro mit F5 starte, überschreibt er standardmäßig immer die erste Zeile oder hängt er sich unten dran?

Danke für die Mühe.
Bitte warten ..
Mitglied: oceangirl
13.10.2013 um 22:19 Uhr
Hallo zusammen,

ich bin froh, dass ich auf diese Seite gestossen bin, denn auch ich moechte gerne Daten aus eine Excel Tabelle auslesen um sie zunaechst im Format zu vereinheitlichen und dann mit xml auszulesen.

Bei mir sind die Daten jedoch deutlich unstrukturierter. Die Daten werden normalerweise mit Bezeichnung und Wert gefuehrt, koennen aber ganz unterschiedlich aufgeschluesselt sein:

1.Der einfachste Fall: Alles steht einzeln in Spalten oder Zeilen

A:B
Vorname:Martin
Nachname: Heinz

oder

A:B
Vorname:Nachname:
Martin:Heinz

2.So gibt es Bezeichnung - Werte die hintereinander in einer Zeile vorkommen.

Bsp:
A:B:C:D:E
1. Vorname:Sven: :Nachname:Mueller
2. Geburtstag:13.10.2013: :Beruf: Ackerer

3.Es gibt Bezeichnung- Werte bei denen Leerzeichen dazwischen stehen.

Bsp:
A:B:C:
Vorname: : Sven:

4. Um die Verwirrung komplett zu machen werden teils unterschiedliche Bezeichnungen vergeben, also bei manchen heisst es geboren am, bei anderen Geburtstag.

Diese Daten wuerde ich gerne in eine Tabelle bringen, um sie mit xml zu exportieren.

Das soll dann so aussehen:


A:B:C:D
1.Vorname:Nachname:Geburtstag:Beruf
2.Sven:Mueller:22.04.2013:Ackerer
3.Martin:Heinz 13.10.2013:Landwirt

Ist das moeglich oder zu unstrukturiert?

Viele Gruesse
oceangirl
Bitte warten ..
Mitglied: bastla
13.10.2013 um 22:34 Uhr
Hallo oceangirl und willkommen im Forum!

Erstelle besser einen eigenen "Frage"-Beitrag - hier dürften nicht allzu viele potenzielle Helfer vorbeikommen ...

... ansonsten: Wenn die Dateien derart unterschiedlich aufgebaut sind, solltest Du vorweg Dateien mit gleicher Struktur in Ordnern zusammenfassen und dann auf jeden Ordner eine angepasste VBA-Variante "los lassen" ...

Grüße
bastla
Bitte warten ..
Mitglied: oceangirl
13.10.2013 um 23:20 Uhr
Ok danke bastler,

mache ich morgen nochmal einen neuen Thread und schaue ob es da einheitliche Strukturen gibt.

Gruss
oceangirl
Bitte warten ..
Mitglied: AlexBerlin
21.07.2016 um 13:41 Uhr
Hallo zusammen,
hallo hilfsbereiter Bastla,

gerne mache ich auch einen neuen Thread auf, aber mein Problem ähnelt den hier Erwähnten sehr.

folgendes Problem: ich habe rund 60 verschiedene Exceldateien mit jeweils 53 Reitern. 52 Reiter sollen vom Bediener ausgefüllt werden und der letzte Reiter enthält alle Daten des gesamten Jahres in Tabellenform (Name des Reiters in allen 60 Dateien ist "Auswertung 2016").

Aufbau des Reiters Auswertung 2016, welcher so auch in die neue große Auswertung übernommen werden soll:


Datum Name Zeit Beschreibung usw....
xx.xx.xx xxx xx:xx xxx



Alle Dateien liegen in einem Ordner, die Reiter und der Aufbau ist komplett identisch, nur die Benennung der Datei ist unterschiedlich (z.B. B01, B02, B03,...,B60, usw.). Nun möchte ich wöchentlich in einem neuen Tabellenblatt und einem neuen Ordner eine Auswertung fahren und alle gesammelten Daten der 60 Dateien in einer Pivottabelle grafisch darstellen. Kann mir jemand mit einem Makro weiterhelfen, eventuell der hilfsbereite bastla?

Vielen Dank und beste Grüße
AlexBerlin
Bitte warten ..
Mitglied: AlexBerlin
21.07.2016 um 13:46 Uhr
Idealerweise wird die Gesamtauswertung jede Woche um die aktuellen Werte erweitert
Bitte warten ..
Mitglied: bastla
21.07.2016 um 23:17 Uhr
Hallo AlexBerlin und willkommen im Forum !

Hilfsbereit wäre ich zwar grundsätzlich, bin aber leider derzeit beruflich stark gefordert - daher doch auch an Dich der Vorschlag, einen neuen (und damit im Forum prominenter platzierten) Beitrag zu erstellen ...

Grüße
bastla
Bitte warten ..
Mitglied: MartiniBerlin
17.08.2016 um 18:00 Uhr
Hallo,

das auslesen in die neue Datei klappt super. Aber er liest aus der Quelldatei immer nur einmal z.B. Name, Vorname aus. Was muss ich hinzufügen, wenn alle Namen, Vornamen aus der Quelldatei ausgelesen werden sollen?

Vielen Dank im voraus
Bitte warten ..
Ähnliche Inhalte
Batch & Shell
Wert in einer TXT Datei suchen
Frage von nolle99Batch & Shell11 Kommentare

Hallo Leute Ich habe ein Problem Ich habe mir von meiner Seite alle URLs in einer TXT gespeichert (30.000 ...

VB for Applications
VB Skript Excel Datei
gelöst Frage von FragerVB for Applications3 Kommentare

Hallo Zusammen, Ich brauche eure Hilfe. Ich habe eine Datei 1.xlsx nun brauche ich ein Skript, was die Datei ...

Microsoft Office
Excel 2010 schreibgeschützte Datei
Frage von Florian86Microsoft Office

Hallo, kennt jemand das Phänomen Eine Excel Datei ist von einem User geöffnet. Ein zweiter und dritter möchte diese ...

Bibliotheken & Toolkits
Eine beschädigte Excel-Datei
Frage von RasmusMorrsBibliotheken & Toolkits4 Kommentare

Hallo, Leute! Alle meine Excel-Dateien sind beschädigt und einige von ihnen sich nicht mehr öffnen lassen. Ich habe Paar ...

Neue Wissensbeiträge
Humor (lol)
Administrator.de Perlen
Tipp von DerWindowsFreak2 vor 1 TagHumor (lol)3 Kommentare

Hallo, Heute beim stöbern auf dieser Seite bin auf folgenden Thread aus dem Jahre 2006 gestossen: Was meint ihr? ...

Erkennung und -Abwehr
OpenSSH-Backdoor Malware erkennen
Tipp von Frank vor 2 TagenErkennung und -Abwehr

Sicherheitsforscher von Eset haben 21 Malware-Familien untersucht. Die Malware soll Hintertüren via OpenSSH bereitstellen, so dass Angreifer Fernzugriff auf ...

iOS
WatchChat für Whatsapp
Tipp von Criemo vor 5 TageniOS5 Kommentare

Ziemlich coole App für WhatsApp User in Verbindung mit der Apple Watch. Gibts für iOS sowohl als auch für ...

iOS
IOS hat nen Cursor!
Tipp von Criemo vor 6 TageniOS5 Kommentare

Nette Funktion im iOS. iPhone-Mauszeiger aktivieren „Nichts ist nerviger, als bei einem Tippfehler zu versuchen, den iOS-Cursor an die ...

Heiß diskutierte Inhalte
Festplatten, SSD, Raid
SSD zeigt falsche Werte
Frage von karl2014Festplatten, SSD, Raid25 Kommentare

Ich habe ein Problem mit der SSD in meinem Laptop mit Windows 10. Es ist eine 1Tb Platte die ...

Grafikkarten & Monitore
PCIe 1.0 Grafikkarte für 3840x2160
Frage von Windows10GegnerGrafikkarten & Monitore24 Kommentare

Hallo, mein Vater hat einen neuen Monitor gekauft, welcher eine native Auflösung von 3840*2160 hat. Diese muss jetzt auch ...

Windows 10
Windows Enterprise 1809 Eval nicht bootbar
Frage von Sunny89Windows 1022 Kommentare

Hallo zusammen, bevor ich mich jetzt noch stundenlang rumärger wollte ich euch fragen, ob Ihr die gleichen Probleme habt ...

Ubuntu
Installation freerdp 2.0.0-rc4
Frage von kristovUbuntu20 Kommentare

Hallo, möchte freerdp 2.0.0-rc4 auf linux mint 18.3 installieren, habe aber keine Ahnung, wie das funktioniert. freerdp 1.1 ist ...