Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Microsoft Microsoft Office

Mitglied: Arafat

Arafat (Level 1) - Jetzt verbinden

03.11.2006, aktualisiert 18.10.2012, 48690 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 ..
Neuester Wissensbeitrag
Microsoft

Lizenzwiederverkauf und seine Tücken

(5)

Erfahrungsbericht von DerWoWusste zum Thema Microsoft ...

Heiß diskutierte Inhalte
Windows Netzwerk
Windows 10 RDP geht nicht (16)

Frage von Fiasko zum Thema Windows Netzwerk ...

Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Microsoft Office
Keine Updates für Office 2016 (13)

Frage von Motte990 zum Thema Microsoft Office ...