Auslesen von Grunddaten aus verschiedenen Excel Dateien in eine neue Tabelle

B

barnetta007

Grünschnabel
Hallihallo!

Ich habe eine (manuell) sehr mühselige Aufgabe vor mir, die jetzt jeden Monat bevorstehen würde, sich aber wahrscheinlich gut per VBA programmieren lassen würde. Leider fehlt mir dazu aber das Fachvokabular :(

Ich muss aus einer Vielzahl an Excel Dateien (die sich aber in einem Ordner befinden) vier Parameter (Werkstoff, Chargennummer, Solllänge, Istlänge) herauslesen, die sich immer in der gleichen Zelle (A2, A4, A7, B7) befinden. Diese wollte ich dann in eine Ergebnistabelle (mit den eben genannten Parametern in der Kopfzeile) mit fortlaufenden Zeilen kopieren.

Jetzt der Teil von dem ich leider Nichtmals weiß, ob es überhaupt realisierbar wäre:
In einem weiteren Worksheet der jeweiligen Exceldateien gibt es einen ellenlangen Bericht mit einer wichtigen Info, die leider NICHT immer in der gleichen Zeile auftritt. Diese soll dann in einer weiteren Spalte als "Verlängerung" eingelesen werden.

Diese Info hat zum Beispiel den Code "043". Steht "043" bspw. in Zelle A25 brauche ich den Zellwert B25 rechts davon, dieser ist genau wie Soll und Istlänge ein Integer. Jetzt das I-Tüpfelchen drauf: In diesem Bericht kann der "043"-Code durchaus 2x vorkommen. Diese beiden Werte müssten dann idealerweise aufsummiert werden...

Ich bin gerade dabei mir über Tutorials und learning by doing VBA beizubringen, jedoch übersteigt diese Aufgabe leider jegliche Kompetenz von mir. Ich weiß nicht ob diese Aufgabe so zu realisieren ist, aber über Hilfe wäre ich unendlich dankbar.

Liebe Grüße und einen schönen Abend,
Andreas
 
Zu realisieren? Prinzipell ja
Hängt aber von verschiedenen Faktoren ab.
Die "Quell"-Excel-Dateien:
Wieviele Worksheets pro Quell-Datei?
Haben die Worksheets eindeutige Namen?
Sind die Sheet-Namen immer gleich? (Beispiel: Quell-Datei-Name "myExcelFile001.xlsx", Tabelle1 (wo Werkstoff etc. steht) heisst "Messdaten", Tabelle2 heisst "Informationen" u.ä.)
Stehen die Messdaten immer auf demselben Blatt? (Beispiel: Stehen die Messdaten immer auf dem ersten Blatt und die Infos auf dem zweiten Blatt)
Soll die Zieldatei immer neu erzeugt werden, oder über die Zeit hinweg immer nur aktualisiert/Daten unten angefügt werden (Datums-Stempel?)?
Haben die Infos immer einen (und denselben) Identifier?

Das sind jetzt nur die Faktoren, die mir auf die Schnelle eingefallen sind.
 
Die ist gut zu realisieren.


Alles in allem müsste nachher der Code in etwa so aussehen
Visual Basic: 
	Dim fso as Object
	Dim fileObj As Objecz
	Dim wbSource As WorkBook
	Dim wsSource as Worksheet
	Dim wsTarget as Worksheet
	Dim actTargetRowNr As Long
	Dim result43 As Variant

	Set wsTarget = Worksheets("Meine Zieltabelle")							'Zieltabelle auswäheln
	actTargetRowNr =wsTarget.Cells.SpecialCells(xlCellTypeLastCell).row		'Letzte Zeile in der Zieltabelle ermitteln

	'FileSytemObject anlegen
	Set fso = CreateObject("Scripting.FileSystemObject")
	For Each fileObj in fso.getFolder("C:\maydata").Files
		If fileObj.name Like "*.xlsx" Then
			actTargetRowNr = actTargetRowNr + 1								'Zielzeile ermitteln
			Set wbSource = Workbooks.open(fileObj.path)						'Excedatei öffnen
			Set wsSource = wb.Worksheets(1)									'Erstes Sheet auswählen
			wsTarget.Cells(actTargetRow, 1).Value = wsSource.Range("A2")	'A2 auselsen und in die erste Spalte schreiben
			'//TODO wietere Felder des ersten Sheets auslesen
			
			Set wsSource = wb.Worksheets(2)									'Zweites Sheet auswählen
			' Alle Werte aus B:B zusammenrechnen, die in A:A den Wert 043 haben
			result43 = WorksheetFunction.Sumif(wsSource.Range("A:A"), "043", wsSource.Range("B:B"))
			wsTarget.Cells(actTargetRow, 5).Value = result43				'Wert eintragen'
			wbSource.close
		End If
	Next fileObj
 
DIe Aufgabe ist jetzt um einiges leichter geworden.
Ich muss nichtmals berechnen, sondern nur aus der Vielzahl an Dateien diese unten genannten Zellen (Immer an gleicher Stelle in Quelldateien) in einer neuen Tabelle zusammenfassen, genauso wie Yaslaw es freundlicherweise erstellt hatte.

Nur leider wird die Aufgabe nicht richtig ausgeführt :/ Kann es vielleicht daran liegen, dass die Dateien .xls sind?




Visual Basic: 
   Option Explicit
  
   Sub TestlaufMakro()
    
    Dim fso As Object
    Dim fileObj As Object
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim actTargetRowNr As Long
  

    Set wsTarget = Worksheets("Meine Zieltabelle")                          'Zieltabelle auswäheln
    actTargetRowNr = wsTarget.Cells.SpecialCells(xlCellTypeLastCell).Row    'Letzte Zeile in der Zieltabelle ermitteln

    'FileSytemObject anlegen
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each fileObj In fso.getFolder("C:\Users\Andi\Desktop\Makroaufgabe").Files
        If fileObj.Name Like "*.xls" Then
            actTargetRowNr = actTargetRowNr + 1                             'Zielzeile ermitteln
            Set wbSource = Workbooks.Open(fileObj.Path)                     'Excedatei öffnen
            Set wsSource = wb.Worksheets(2)                                 'Erstes Sheet auswählen
            wsTarget.Cells(actTargetRow, 1).Value = wsSource.Range("A1")
            wsTarget.Cells(actTargetRow, 2).Value = wsSource.Range("B1")
            wsTarget.Cells(actTargetRow, 3).Value = wsSource.Range("E1")
            '//TODO wietere Felder des ersten Sheets auslesen
            
            Set wsSource = wb.Worksheets(1)                                 'Zweites Sheet auswählen
            wsTarget.Cells(actTargetRow, 4).Value = wsSource.Range("F1")
            wsTarget.Cells(actTargetRow, 5).Value = wsSource.Range("F3")
            wbSource.Close
        End If
    Next fileObj


End Sub
 
Okay ich habe es jetzt hinbekommen. Vielen Dank nochmal für die Hilfe von letzter Woche! :-)

Liebe Grüße und schönen Sonntag

Visual Basic: 
   Option Explicit
   
   Sub TestlaufMakro()
    
    Dim fso As Object
    Dim fileObj As Object
    Dim wbTarget As Workbook
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim actTargetRowNr As Long
   
Set wbTarget = Workbooks.Add
wbTarget.SaveAs Filename:="C:\Users\Andi\Desktop\ConcatFilesFolder\Zieltabelle.xlsx"



    Set wsTarget = wbTarget.Worksheets(1)
 
    
    actTargetRowNr = wsTarget.Cells.SpecialCells(xlCellTypeLastCell).Row    'Letzte Zeile in der Zieltabelle ermitteln

    'FileSytemObject anlegen
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each fileObj In fso.getFolder("C:\Users\Andi\Desktop\ConcatFilesFolder").Files
        If fileObj.Name Like "*.xls" Then
            actTargetRowNr = actTargetRowNr + 1                             'Zielzeile ermitteln
            Set wbSource = Workbooks.Open(fileObj.Path)                     'Excedatei öffnen
            Set wsSource = wbSource.Worksheets(2)                                 'Erstes Sheet auswählen
            wsTarget.Cells(actTargetRowNr, 1).Value = wsSource.Range("A1")
            wsTarget.Cells(actTargetRowNr, 2).Value = wsSource.Range("B1")
            wsTarget.Cells(actTargetRowNr, 3).Value = wsSource.Range("E1")
            '//TODO wietere Felder des ersten Sheets auslesen
            
            Set wsSource = wbSource.Worksheets(1)                                 'Zweites Sheet auswählen
            wsTarget.Cells(actTargetRowNr, 4).Value = wsSource.Range("F1")
            wsTarget.Cells(actTargetRowNr, 5).Value = wsSource.Range("F3")
            wbSource.Close
        End If
    Next fileObj


End Sub


End Sub
 
Zuletzt bearbeitet:
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück