Microsoft Excel

Herbers Excel/VBA-Archiv

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

Daten zusammen führen.

Betrifft: Daten zusammen führen.
von: FP
Geschrieben am: 17.04.2003 - 10:41:48

Hallo zusammen.

Ich habe ca. 500 Excel-Dateien. In diesen Dateien, stehen Zahlen oder Buchstaben, verteilt in diversen Feldern (Bsp.: B95, C115, D40, usw...)

Die Felder sind, bei allen 500 Dateien, die gleichen.

Nun sollte ich, für eine Auswertung, in einer neuen Excel-Datei, pro Datei (aus den 500), eine Datenzeile haben.

Wer kann mir da helfen?

  

Re: Daten zusammen führen.
von: Ramses
Geschrieben am: 17.04.2003 - 11:14:00

Hallo,

schreib mal welche Zellen das tatsächlich sind und in welcher Reihenfolge sie angebracht werden müssen.
Gibt es Überschriften die definiert sind, oder müssen die noch erstellt werden.
Sind alle Dateien in einem Ordner ?

Gruss Rainer

  

Re: Daten zusammen führen.
von: FP
Geschrieben am: 17.04.2003 - 11:41:10

Hi

es sind die felder:
B95, C95, B96, B97, B98, C98, B99, B100:E100, B101:E101, B102:F102, B103:F103, B104:F104, B105:F105,
B106:E115

Genau o.g. Reihenfolge. bei B100:E100 wäre es B100, C100, D100, E100 und bei B106:E115 wäre es B106, C106, D106, E106, dann B107, C107, D107 usw.

Die Ueberschriften müssen noch erstellt werden. D.h. die könnte man nachträglich auf die erste Zeile schreiben.

Alle Dateien befinden sich im gleichen Ordner.

Vielen Dank für die Hilfe.

  

Re: Daten zusammen führen.
von: Ramses
Geschrieben am: 17.04.2003 - 11:56:21

Hallo

das dauert ein bischen, aber ich schaue mal was ich hinbring.

Gruss Rainer

  

Gelöst
von: Ramses
Geschrieben am: 17.04.2003 - 14:40:05

Hallo FP,

Das Makro frägt den Pfad\bzw. das Verzeichnis ab in dem die Dateien liegen. Bitte den Pfad Exact angeben in dieser Form "C:\Verzeichnis".
Das Makro prüft und öffnet deine 500 Dateien und transferiert die Daten in die aktuelle Arbeitsmappe in eine Tabelle mit dem Namen "Datenkonsolidierung"

Deine Daten liegen in dieser Form vor:

Tabelle1
 BCDEF
9512   
963    
974    
9856   
997    
100891011 
10112131415 
1021617181920
1032122232425
1042627282930
1053132333435
10636373839 
10740414243 
10844454647 
10948495051 
11052535455 
11156575859 
11260616263 
11364656667 
11468697071 
11572737475 
Excel Tabellen einfach im Web darstellen   Excel Jeanie HTML  2.0    Download  


Kopiere das Makro in eine die Arbeitsmappe wo du die Konsolidierung durchführen willst:


Option Explicit

Sub Consolidation_of_external_Files()
Dim i As Long, n As Integer, m As Integer, TotFiles As Long
Dim Cr As Long, Cc As Integer, Qe As Integer, myError As Integer
Dim gefFile As String, dname As String, Dateiform As String
Dim Suchpfad As String, suchbegriff As String
Dim dataWks As String, startWks As String, aktWkb As String
Dim oldStatus As Variant
'Variablen füllen
'Zeilen Start der Datenerfassung in der Konsolidierungstabelle
Cr = 2
Cc = 1
'Namen der Tabelle definieren
dataWks = "Konsolidierungsdaten"
startWks = ActiveSheet.Name
aktWkb = ActiveWorkbook.Name
'Datentyp definieren
Dateiform = "*.xls"
'existierende Konsolidierungstabelle suchen
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = dataWks Then
        Qe = MsgBox("Die Konsolidierungstabelle existiert schon!" & Chr$(13) & "Soll sie gelöscht werden?", vbCritical + vbDefaultButton2 + vbYesNo, "Datenkonflikt")
        If Qe = vbNo Then
            MsgBox ("Das Makro kann nicht ausgeführt werden wegen entstehenden Datenkonflikten")
            Exit Sub
        End If
        Application.DisplayAlerts = False
        Worksheets(i).Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next i
Worksheets.Add
ActiveSheet.Name = dataWks
Worksheets(startWks).Select
On Error GoTo Errorhandler
myError = 1
'Pfad anfordern
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
ChDir Suchpfad
'Start der Datenverarbeitung
Application.ScreenUpdating = False
oldStatus = Application.StatusBar
'Pfad durchsuchen
With Application.FileSearch
    .LookIn = Suchpfad
    .SearchSubFolders = False
    .Filename = Dateiform
    myError = 2
    If .Execute() > 0 Then
        TotFiles = .FoundFiles.Count
        Application.StatusBar = "Total " & TotFiles & " gefunden"
        For i = 1 To (.FoundFiles.Count)
            gefFile = .FoundFiles(i)
            Application.StatusBar = "Mappe " & i & " von total " & TotFiles & " in Bearbeitung"
            Workbooks.Open Filename:=gefFile
            Range("B95").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("C95").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("B96").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("B97").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("b98").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("C98").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            Range("B99").Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
            Cc = Cc + 1
            'Schleife für B100 - E 101
            For n = 100 To 101
                For m = 2 To 5
                    Cells(n, m).Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
                    Cc = Cc + 1
                Next m
            Next n
            'Schleife für B102 - F105
            For n = 102 To 105
                For m = 2 To 5
                    Cells(n, m).Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
                    Cc = Cc + 1
                Next m
            Next n
            'Schleife für B106 - E115
            For n = 102 To 115
                For m = 2 To 4
                    Cells(n, m).Copy Destination:=Workbooks(aktWkb).Worksheets(dataWks).Cells(i + 1, Cc)
                    Cc = Cc + 1
                Next m
            Next n
            ActiveWorkbook.Close savechanges:=False
            Cc = 1
        Next i
    End If
End With
MsgBox "Alle Dateien in " & Suchpfad & " bearbeitet"

OK_Exit:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
Exit Sub

Errorhandler:
Select Case myError
    Case 1
        MsgBox "Der Pfad existiert nicht" & Chr$(13) & "Das Makro wird beendet"
    Case 2
        MsgBox "Undefinierter Datenfehler: Das Makro wird abgebrochen"
End Select
Resume OK_Exit
End Sub 

     Code eingefügt mit Syntaxhighlighter 1.16


Das Ergebnis sieht dann so aus:


Konsolidierungsdaten
 ABCDEFGHI
1         
21234567910
31234567910
41234567910
Excel Tabellen einfach im Web darstellen   Excel Jeanie HTML  2.0    Download  

Die restlichen 61 Spalten habe ich jetzt hier nicht dargestellt.
Die Überschriften musst du noch selbst definieren.

Gruss und viel Spass

Rainer

 

Beiträge aus den Excel-Beispielen zum Thema "Daten zusammen führen."