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

Wie einzelne Zellen aus mehreren Excel-Dateien auslesen und in eine neue Datei einfügen?

Frage Microsoft Microsoft Office

Mitglied: ThiesK

ThiesK (Level 1) - Jetzt verbinden

27.07.2012, aktualisiert 11:30 Uhr, 10725 Aufrufe, 13 Kommentare

Hallo liebes Forum,

nach stundenlanger Suche im Internet und keiner wirklich gefundenen Lösung hoffe ich, dass hier mir jemand helfen kann.
Für die Arbeit soll ich aus vielen Excel-Dateien eine Auswertung vornehmen. Ich dachte mir am Besten per Makro/VBA. Da ich mich damit jedoch nicht so gut auskenne, hoffte ich ein bestehendes Programm umzuschreiben, was jedoch scheiterte..

Die einzelnen Excel-Dateien sehen so aus, dass immer aus der "Tabelle1" die Informationen aus den Zellen "B28", "E28", "H28", "O28", "Q28", "A30", "A31" ausgelesen und dann ab der 3.Zeile (Die ersten beiden Zeilen sollen für Überschriften da sein) spaltenweise eingefügt werden sollen. Also: Alle Werte von "B28" untereinander, alle Werte von "E28" untereinander, etc.

Für eure Unterstützung wäre ich euch sehr sehr dankbar!

Ich nutze Excel 2007 und Win XP. Falls ihr noch weitere Fragen habt, werde ich sie schnellstmöglichst beantworten!

Vielen Dank noch einmal!

Gruß ThiesK
Mitglied: Eierbaer
27.07.2012 um 14:27 Uhr
Hallo ThiesK,

probiers einmal hiermit, muss Du natürlich etwas anpassen, aber funktioniert:

01.
Option Explicit 
02.
 
03.
Public Sub ExcelDateienAuswerten() 
04.
 
05.
    Dim strDateiname As String 
06.
    Dim strPfad      As String 
07.
    Dim lngZeile     As Long 
08.
     
09.
    'Pfadangabe, in dem die zu lesenden Excel-Datei (*.xls) liegen 
10.
    strPfad = "F:\Projekte\Administrator.de\Quelle\" 
11.
     
12.
    'Den 1. Dateinamen holen 
13.
    strDateiname = Dir(strPfad & "*.xls") 
14.
 
15.
    'Startzeile festlegen 
16.
    lngZeile = 3 
17.
     
18.
    'Solange ein Dateiname gelesen wird 
19.
    Do While Not strDateiname = "" 
20.
         
21.
        'Datei verarbeiten 
22.
        Call TabVerarb(strPfad & strDateiname, lngZeile) 
23.
         
24.
        'nächsten Dateinamen holen 
25.
        strDateiname = Dir() 
26.
         
27.
        'Zeilenzähler erhöhen 
28.
        lngZeile = lngZeile + 1 
29.
     Loop 
30.
 
31.
End Sub 
32.
 
33.
 
34.
 
35.
Public Sub TabVerarb(strPfad As String, lngZeile As Long) 
36.
    Dim strMeSH As String 
37.
    Dim strDatei As String 
38.
    Dim strSH As String 
39.
     
40.
    'Dateinamen extrahieren 
41.
    strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\"))) 
42.
     
43.
    'Eigenen Namen merken 
44.
    strMeSH = ActiveWorkbook.Name 
45.
     
46.
    'Datei öffnen 
47.
    Workbooks.Open Filename:=strPfad 
48.
     
49.
    With Workbooks(strMeSH) 
50.
        'Dateinamen und auszuwertenden Zellen übertragen 
51.
        .Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei 
52.
        .Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Tabelle1").Range("B28").Value 
53.
        .Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Tabelle1").Range("E28").Value 
54.
        .Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Tabelle1").Range("H28").Value 
55.
        .Sheets("Tabelle1").Cells(lngZeile, 5) = Workbooks(strDatei).Sheets("Tabelle1").Range("O28").Value 
56.
        .Sheets("Tabelle1").Cells(lngZeile, 6) = Workbooks(strDatei).Sheets("Tabelle1").Range("Q28").Value 
57.
        .Sheets("Tabelle1").Cells(lngZeile, 7) = Workbooks(strDatei).Sheets("Tabelle1").Range("A30").Value 
58.
        .Sheets("Tabelle1").Cells(lngZeile, 8) = Workbooks(strDatei).Sheets("Tabelle1").Range("A31").Value 
59.
    End With 
60.
     
61.
    'Quelldatei schließen 
62.
    Workbooks(strDatei).Saved = True 
63.
    Workbooks(strDatei).Close 
64.
 
65.
End Sub 
66.
 

Gruß
Rüdiger aus Minden
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:39 Uhr
Hallo ThiesK!

Oder so:
01.
Option Explicit 
02.
 
03.
Const sXlsPath = "D:\Temp" 
04.
Const iStartZeile = 3 
05.
Const iStartSpalte = 1 
06.
 
07.
Const Zellen = "B28,E28,H28,O28,Q28,A30,A31" 
08.
 
09.
 
10.
Sub CopyExternData() 
11.
    Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet 
12.
    Dim aCells As Variant, iNextLine As Long, i As Integer 
13.
     
14.
    Set oWks0 = ThisWorkbook.ActiveSheet 
15.
     
16.
    aCells = Split(Zellen, ","):  iNextLine = iStartZeile 
17.
     
18.
    Set oFso = CreateObject("Scripting.FilesystemObject") 
19.
     
20.
    For Each oFile In oFso.GetFolder(sXlsPath).Files 
21.
        If LCase(oFso.GetExtensionName(oFile.Name)) = "xls" Then 
22.
            If ThisWorkbook.Name <> oFile.Name Then 
23.
                Set oWkb1 = Workbooks.Open(oFile.Path) 
24.
                Set oWks1 = oWkb1.Sheets(1) 
25.
                For i = 0 To UBound(aCells) 
26.
                    oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oWks1.Range(Trim(aCells(i))).Value 
27.
                Next 
28.
                oWkb1.Close False 
29.
                iNextLine = iNextLine + 1 
30.
            End If 
31.
        End If 
32.
    Next 
33.
End Sub
Gruß Dieter

[edit] Hatte doch was übersehen (ThisWorkbook.Path anstatt .Name) [/edit]
Bitte warten ..
Mitglied: ThiesK
27.07.2012 um 15:16 Uhr
Hallo Rüdiger,

vielen vielen Dank für deine Mühe und verständnisvolle Kommentargebung im Programm. Du hast mir sehr geholfen, dass Programm arbeitet einwandfrei! Als gelernter Nutzer der "C"-Programmierung, konnte ich das Programm jetzt gut nachvollziehen und die Arbeitsweise verstehen! Zwischenzeitlich hatte ich mir aus vielen verschiedenen Programmteilen aus diesem Forum ein eigenes Programm geschrieben, dieses hatte jedoch etliche Bugs...

Also nochmal: Vielen Dank für deine Mühe. Ich hoffe auch andere Nutzer mit einem ähnlichen Problem können hieraus schöpfen

Grüße
Thies
Bitte warten ..
Mitglied: bastla
27.07.2012 um 15:31 Uhr
[OT] @Dieter
Irgendwie vermisse ich noch die "Union()"-Variante ..

Grüße
bastla
[/OT]
Bitte warten ..
Mitglied: ThiesK
27.07.2012 um 15:52 Uhr
Ja, ich habe diese Version auch noch einmal ausprobiert, aber da kommt das Programm in eine Endlosschleife... Trotzdem vielen Dank für die Mühe, Dieter, auch wenns noch nicht 100%ig hinhaut, weiß ich das zu schätzen!

Grüße
Thies
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:20 Uhr
[OT]
Hallo bastla!

Die hatte ich auch zuerst im Auge gehabt, aber das funktioniert in der Regel nur, wenn sich alle Werte in der gleichen Zeile befinden. Ansonsten geht's über Areas und da werden alle Werte die auseinanderliegen in ein Item und die Werte, die zusammen liegen (A30, A31) werden als Array in Item übernommen

Gruß Dieter
[/OT]
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:41 Uhr
Hallo Thies!

Endlosschleife, wie das?


Gruß Dieter


PS. Oben geändert: Von ThisWorkbook.Path nach ThisWorkbook.Name...
Bitte warten ..
Mitglied: beggagsell
05.02.2013 um 09:57 Uhr
Hallo zusammen,
ich bin neu im Bereich VB Programmierung und habe mir die Lösung hier angeschaut. Die trifft meine eigene Anforderung fast genau.

Meine Frage: Wie kann ich es hinterlegen, dass weitere Daten über eine Schleife wiederholdend aus einem Arbeitsblatt ausgelesen und die ausgelesenen Werte untereinander dargestellt werden?

B28,E28,H28,O28,Q28,A30,A31
B128,E128,H128,O128,Q128,A130,A131
B228,E228,H228,O228,Q228,A230,A231
..... (500 Auswertungen, die Zeilenabstände erhöhen sich jeweils um 100)


Liebe Grüße

Beggagsell
Bitte warten ..
Mitglied: 76109
23.02.2013, aktualisiert um 11:40 Uhr
Hallo Beggagsell!

Hatte leider wenig Zeit, von daher etwas verspätet in etwa so:
01.
Option Explicit 
02.
 
03.
Const sXlsPath = "D:\Temp" 
04.
Const iStartZeile = 3           'Diese Arbeitsmappe, Daten ab Zeile 
05.
Const iStartSpalte = 1          'Diese Arbeitsmappe, Daten ab Spalte 
06.
 
07.
Const iStartCopyZeile = 28      'Externe Arbeitsmappe,Daten ab Zeile (28) 
08.
Const iNextCopyZeile = 100      'Externe Arbeitsmappe,Daten nächste Zeile (+100) 
09.
 
10.
Sub CopyExternData2() 
11.
    Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet 
12.
    Dim aOfs As Variant, oNextCell As Range, iNextLine As Long, i As Integer 
13.
     
14.
    Set oWks0 = ThisWorkbook.ActiveSheet 
15.
    Set oFso = CreateObject("Scripting.FilesystemObject") 
16.
     
17.
    'Relative Offset-Adressen (Aktuelle Zeile + ?, Spalte 1 + ?) 
18.
    'Bei aktueller Zeile 28 entspricht dies: B28, E28, H28, O28, Q28, A30, A31 
19.
    aOfs = Array(Array(0, 1), _ 
20.
                 Array(0, 4), _ 
21.
                 Array(0, 7), _ 
22.
                 Array(0, 14), _ 
23.
                 Array(0, 16), _ 
24.
                 Array(2, 0), _ 
25.
                 Array(2, 0)) 
26.
     
27.
    iNextLine = iStartZeile 
28.
     
29.
    Application.ScreenUpdating = False 
30.
     
31.
    For Each oFile In oFso.GetFolder(sXlsPath).Files 
32.
        If LCase(oFso.GetExtensionName(oFile.Name)) = "xls" Then 
33.
            If ThisWorkbook.Name <> oFile.Name Then 
34.
                Set oWkb1 = Workbooks.Open(oFile.Path) 
35.
                Set oWks1 = oWkb1.Sheets(1) 
36.
                 
37.
                'Set Bezugs-Zelle (Bei Zeile 28: A28) 
38.
                Set oNextCell = oWks1.Cells(iStartCopyZeile, "A") 
39.
                 
40.
                'Daten kopieren, solange Zelle (B28, B128, ...) mit Inhalt 
41.
                Do While oNextCell.Offset(aOfs(0)(0), aOfs(0)(1)).Text <> "" 
42.
                    For i = 0 To UBound(aOfs) 
43.
                        oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = oNextCell.Offset(aOfs(i)(0), aOfs(i)(1)).Value        
44.
                    Next 
45.
                     
46.
                    'Set Next Bezugs-Zelle + 100 Zeilen (A128, A228, ...) 
47.
                    Set oNextCell = oNextCell.Offset(iNextCopyZeile, 0):  iNextLine = iNextLine + 1 
48.
                Loop 
49.
                oWkb1.Close False 
50.
            End If 
51.
        End If 
52.
    Next 
53.
    Application.ScreenUpdating = True 
54.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: beggagsell
26.02.2013 um 13:50 Uhr
Hallo Dieter,

Danke für die Information.
Leider funktioniert das Makro nicht.
Es wird zwar die Datei in c:\temp geöffnet, aber kein Wert in die Zieltabelle geschrieben.
Die einzige Änderung die ich vornehme ist die Umstellung auf c:\temp
Könntest du noch mal drüberschauen - wäre echt super.

Danke

Beggagsell
Bitte warten ..
Mitglied: 76109
27.02.2013, aktualisiert um 00:18 Uhr
Hallo Beggagsell!

Sorry, bei mir funktionierts?

Befinden sich die Daten im ersten Tabellenblatt und stimmen die Basis-Zellen (B28, E28, H28, O28, Q28, A30, A31) überein. Ausserdem dürfen die Bezugszellen (B28, B128, B...) nicht leer sein...

Gruß Dieter
Bitte warten ..
Mitglied: beggagsell
27.02.2013 um 15:41 Uhr
Hallo Dieter,
so ist das nun mal...
Wenn man die Datei nicht mit der Endung xlsx speichert, klappt das besser. (geöffnet wurde eine andere Datei im Verzeichnis ohne Daten in den jeweiligen Feldern)

Du hast mir mehrere Stunden mit meiner Freundin verschafft, die ich sonst am PC verbracht hätte.

Herzlichen Dank - eine Top Lösung.
Bitte warten ..
Mitglied: HC-Ahnungslos
18.12.2015, aktualisiert um 19:20 Uhr
Einen schönen guten Tag Rüdiger,
ich habe dein Codefragment (erste Lösung) gefunden und nach der Beschreibung passt es perfekt auf meine Bedürfnisse. Leider bin ich ein VBA Laie und kriege es nicht ganz zum laufen. Ich kriege immer den gleichen Fehler 68. in Zeile 13 bei Dir. ich nutze Excel auf dem Mac, könnte es daran liegen? grundsätzlich habe ich eigentlich nur das .xls in .xlsx geändert da ich mit eben diesen Dateien arbeite.

Für einen Tipp wäre ich wirklich sehr dankbar!
Einen schönen Abend noch

Gruß
HC
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (15)

Frage von liquidbase zum Thema Windows Update ...

DSL, VDSL
Problem mit variernder Internetgeschwindigkeit (12)

Frage von schaurian zum Thema DSL, VDSL ...