Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenumbau - spaltendurchlauf mit for?

Tabellenumbau - spaltendurchlauf mit for?
16.10.2008 08:51:36
Reptil
hallo zusammen
ich habe, dank diesem forum ;-), ein makro, welches mir aus vielen exceldateien eine "sammeldatei" mit allen benötigten daten generiert. nun hat sich jedoch eine anforderung geändert, wodurch der aufbau der tabelle nicht so bleiben kann....
bisher sieht die tabelle folgendermaßen aus:
jahr|fabrikname|kostenstelle|einheit|kostenart|januar|februar|.....|dezember|summe
für die neue anforderung wäre jedoch folgender aufbau nötig:
Jahr|monat|fabrikname|kostenstelle|einheit|kostenart
die summe würde nicht zwingend benötigt.
die sub, die bisher für das zusammenführen nötig war sieht aus wie folgt:

Sub Zusammenführen_in_eine_Tabelle(Verzeichnis As String)
' Führt die Daten aus den Dateien in Verzeichnis in einer Datei zusammen
' Daten aus der 1. Tabelle in den Quell-Dateien werden in die Ziel-Tabelle übertragen
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim intI As Integer, Zeile As Long
Dim objFileSearch As FileSearch
Dim löschen As Range
Set objFileSearch = Application.FileSearch
With objFileSearch
'Exceldateien im Verzeichnis suchen
.NewSearch
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Verzeichnis
If .Execute > 0 Then
For intI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & .FoundFiles(intI) & " wird bearbeitet"
'Quelldatei öfnen
Set wbQuelle = Workbooks.Open(FileName:=.FoundFiles(intI), ReadOnly:=True)
'Quelltabelle setzen = 1. Tabellenblatt in Quelldatei
Set wksQuelle = wbQuelle.Worksheets(1)
'Daten aus Quelltabelle in Zieltabelle übertragen
With wksQuelle
If bolTitelzeile = False Then
'Bei 1. Datei aus der Zeile 13 die Spaltentitel (C-O) in die Zeile 2 der _
Ziel-Tabelle übertragen
wksZiel.Range(wksZiel.Cells(2, 5), wksZiel.Cells(2, 17)).Value = _
.Range(.Cells(13, 2), .Cells(13, 15)).Value
bolTitelzeile = True
End If
wksZiel.Cells(ZeileDaten, 3) = wbQuelle.Name 'Name Quelldatei
Select Case wbQuelle.Name        'Vergleicht den Namen der Quelldateien mit der  _
Liste(unten).
'füllt die spalte "fabrikname", hier nicht genau aufgeführt
End Select
For Each löschen In wksZiel.Cells(ZeileDaten, 3)
löschen = Left(löschen, Len(löschen) - 4)
Next
wksZiel.Cells(ZeileDaten, 1) = Year(Date)
wksZiel.Cells(ZeileDaten, 2) = Firmenname  'Firmenname
wksZiel.Cells(ZeileDaten, 4) = fncABC_P(.Range("B9").Text) 'Beschreibungstext
wksZiel.Cells(ZeileDaten, 5) = fncKST(.Range("B10").Text) 'Kostenstelle
'letzte Zeile mit Summe in Spalte B ermitteln
Zeile = .Cells(.Rows.Count, 3).End(xlUp).Row
'Daten aus Summenzeile Spalten C bis O übertragen
wksZiel.Range(wksZiel.Cells(ZeileDaten, 6), wksZiel.Cells(ZeileDaten, 18)).Value = _
.Range(.Cells(Zeile, 3), .Cells(Zeile, 15)).Value
ZeileDaten = ZeileDaten + 1
End With
wbQuelle.Close Savechanges:=False
Next
Application.StatusBar = False
End If
End With
End Sub


meine idee war jetzt, bei dem punkt


'Daten aus Summenzeile Spalten C bis O übertragen
wksZiel.Range(wksZiel.Cells(ZeileDaten, 6), wksZiel.Cells(ZeileDaten, 18)).Value = _
.Range(.Cells(Zeile, 3), .Cells(Zeile, 15)).Value


eine for schleife einzubauen, die die spalten der quelldatei einzeln durchläuft und dann eben die einzelnen werte untereinander und nicht nebeneinander einträgt.
hier ist noch eine dummydatei, wie die quelldateien aussehen:
https://www.herber.de/bbs/user/56051.xls
ich hoffe, es kann mir jemand helfen : /
grüße

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenumbau - spaltendurchlauf mit for?
16.10.2008 11:41:00
Reptil
.... oder wäre es einfacher, die tabelle erst nachdem alle daten importiert wurden zu verändern?
ich hoffe, ich hab mien problem verständlich erklärt... wär echt toll, wenn jemand rat wüsste
grüße
AW: Tabellenumbau - spaltendurchlauf mit for?
16.10.2008 11:53:17
fcs
Hallo Reptil,
die Quelldatei kommt mir bekannt vor.
Du müsstest die Prozedur grob wie folgt anpassen, um die Informationen Zeilenweise für jeden Monat auszugeben.
Da ich nicht die Zeit hab alle Variablen und Funktionen nachzubauen, die in der Prozedur vorkommen, hier eine nur grob getestete Anpassung.
Gruß
Franz

Sub Zusammenführen_in_eine_TabelleNeu(Verzeichnis As String)
' Führt die Daten aus den Dateien in Verzeichnis in einer Datei zusammen
' Daten aus der 1. Tabelle in den Quell-Dateien werden in die Ziel-Tabelle übertragen
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim intI As Integer, Zeile As Long
Dim objFileSearch As FileSearch
Dim varFirmenname, varBeschreibung, varKST
Dim lngSpalte As Long, lngZeile As Long
Set objFileSearch = Application.FileSearch
With objFileSearch
'Exceldateien im Verzeichnis suchen
.NewSearch
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Verzeichnis
If .Execute > 0 Then
'Titelzeile in Zieltabelle eintragen
'Jahr|monat|fabrikname|kostenstelle|einheit|kostenart|Kosten|Dateiname
ZeileDaten = 1 'Titelzeile
wksZiel.Cells(ZeileDaten, 1) = "Jahr"
wksZiel.Cells(ZeileDaten, 2) = "monat"
wksZiel.Cells(ZeileDaten, 3) = "fabrikname"
wksZiel.Cells(ZeileDaten, 4) = "kostenstelle"
wksZiel.Cells(ZeileDaten, 5) = "einheit"
wksZiel.Cells(ZeileDaten, 6) = "kostenart"
wksZiel.Cells(ZeileDaten, 7) = "Kosten"
wksZiel.Cells(ZeileDaten, 8) = "Dateiname"
For intI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & .FoundFiles(intI) & " wird bearbeitet"
'Quelldatei öfnen
Set wbQuelle = Workbooks.Open(Filename:=.FoundFiles(intI), ReadOnly:=True)
'Quelltabelle setzen = 1. Tabellenblatt in Quelldatei
Set wksQuelle = wbQuelle.Worksheets(1)
'Daten aus Quelltabelle in Zieltabelle übertragen
With wksQuelle
Select Case wbQuelle.Name 'Vergleicht den Namen der Quelldateien mit der _
Liste(unten).
'füllt die spalte "fabrikname", hier nicht genau aufgeführt
End Select
varFirmenname = Firmenname  'Firmenname
'Daten aus Feldern oberhalb Tabelle auslesen
varBeschreibung = fncABC_P(.Range("B9").Text) 'Beschreibungstext
varKST = fncKST(.Range("B10").Text) 'Kostenstelle
'letzte Zeile mit Summe in Spalte B ermitteln
Zeile = .Cells(.Rows.Count, 3).End(xlUp).Row
'Daten je Monat einlesen
For lngSpalte = 3 To 14 'Spalten C bis N
'Leistungsarten ohne Summe für Monat ab Zeile 14 einlesen
For lngZeile = 14 To Zeile - 1
ZeileDaten = ZeileDaten + 1
'Jahr vom Wert in Zeile 13 rechts abtrennen und in Zahl verwandeln
wksZiel.Cells(ZeileDaten, 1) = CDbl(Right(.Cells(13, lngSpalte), 4))
'Monat vom Wert in Zeile 13 ausschneiden und in Zahl verwandeln
wksZiel.Cells(ZeileDaten, 2) = CDbl(Left(Right(.Cells(13, lngSpalte), 7), 2))
wksZiel.Cells(ZeileDaten, 3) = varFirmenname
wksZiel.Cells(ZeileDaten, 4) = varKST
wksZiel.Cells(ZeileDaten, 5) = "?" 'Einheit
'Leistungsart aus Spalte B der Zeile einlesen
wksZiel.Cells(ZeileDaten, 6) = .Cells(lngZeile, 2).Text
'Betrag für Leistungsart im Monat aus der Zeile einlesen
wksZiel.Cells(ZeileDaten, 7) = .Cells(lngZeile, lngSpalte).Value
' Dateiname ohne Endung in Spalte 7 eintragen
wksZiel.Cells(ZeileDaten, 8) = Left(wbQuelle.Name, Len(wbQuelle.Name) - 4)
Next
Next
End With
wbQuelle.Close Savechanges:=False
Next
Application.StatusBar = False
End If
End With
End Sub


Anzeige
AW: Tabellenumbau - spaltendurchlauf mit for?
16.10.2008 12:15:04
Reptil
ja, das makro war von dir, aber wollte die anfrage nicht speziell an dich richten, hast ja bestimmt auch noch anderes zu tun : )
die neue datei sieht schon mal richtig gut aus, ich mach mich mal ans anpassen und melde mich, falls es doch noch probleme geben sollte : )
vielen vielen dank auf jeden fall : )
AW: Tabellenumbau - spaltendurchlauf mit for?
17.10.2008 09:14:00
Reptil
hey fcs
ich schreib jetzt doch mal direkt an dich, habe nämlich schon wieder ein recht ähnliches problem.
in die zieldatei sollen noch daten aus einer weiteren datei mit ähnlichem aufbau kommen. ich scheitere grade bei dem versuch, dein makro entsprechend anzupassen.
wäre ganz toll, wenn du mir ein weiteres mal helfen könntest.
hier mal eine Beispieldatei
https://www.herber.de/bbs/user/56067.xls
Wieder möchte ich folgendes tabellenlayout haben:
Jahr|Monat|Kostenstelle|Wert
nur halt diesmal nicht nur für eine Zeile, sondern für alle.... : /
ich lade auch noch mal deine komplette datei hoch. meine versuche findest du in der sub EinfügenMengendaten
https://www.herber.de/bbs/user/56068.xls
das ansteuern der richtigen Datei funktioniert, er zieht auch die richtige kostenstelle ( also die Zahl in spalte a)... nur schreibter mir die im moment knapp 650 untereinander ;-)
wäre echt klasse, wenn du da mal drüber schauen könntest...
gruß
Anzeige
oT "Frage noch offen"
17.10.2008 09:38:00
Reptil
...
AW: oT "Frage noch offen"
17.10.2008 09:58:52
Reptil
....gut, das der haken wieder raus ist -.-
AW: oT "Frage noch offen"
17.10.2008 12:29:00
fcs
Hallo Reptil,
hier die angepasste Prozedur inkl. Funktion, um die KST-Nummer vom Resttext abzutrennen.
Checke in deiner Datei mal die Jahreszahl für Februar. Ich nehme an, dass dies nur ein Fehler in der Beispieldatei war.
Gruß
Franz

Sub EinfügenMengendaten(Verzeichnis2 As String)
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim intI As Integer, Zeile As Long
Dim objFileSearch As FileSearch
Dim lngSpalte As Long, lngZeile As Long
Set objFileSearch = Application.FileSearch
With objFileSearch
'Exceldateien im Verzeichnis suchen
.NewSearch
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Verzeichnis2
If .Execute > 0 Then
ZeileDaten = 1
wksMenge.Cells(ZeileDaten, 1) = "Jahr"
wksMenge.Cells(ZeileDaten, 2) = "Monat"
wksMenge.Cells(ZeileDaten, 3) = "Kostenstelle"
wksMenge.Cells(ZeileDaten, 4) = "Wert (Mio)"
wksMenge.Columns(4).NumberFormat = "#,##0.000" 'Zahlenformat mit 3 Nachkommastellen
For intI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & .FoundFiles(intI) & " wird bearbeitet"
'Quelldatei öfnen
Set wbQuelle = Workbooks.Open(Filename:=.FoundFiles(intI), ReadOnly:=True)
'Quelltabelle setzen = 1. Tabellenblatt in Quelldatei
Set wksQuelle = wbQuelle.Worksheets(1)
'Daten aus Quelltabelle in Zieltabelle übertragen
With wksQuelle
'Letzte Zeile mit Daten
Zeile = .Cells(.Rows.Count, 3).End(xlUp).Row - 1
'Daten ab Zeile 17 einlesen
For lngZeile = 17 To Zeile
For lngSpalte = 3 To 14 'Spalten C bis N
ZeileDaten = ZeileDaten + 1
'Jahr und Monat aus Zeile 15 auslesen
wksMenge.Cells(ZeileDaten, 1) = Year(.Cells(15, lngSpalte))
wksMenge.Cells(ZeileDaten, 2) = Month(.Cells(15, lngSpalte))
'Kostenstelle aus Spalte A einlesen
wksMenge.Cells(ZeileDaten, 3) = fncHerstellerKST(.Cells(lngZeile, 1)) 'KST
'Wert für Monat zu KST einlesen
wksMenge.Cells(ZeileDaten, 4) = .Cells(lngZeile, lngSpalte) 'Wert
Next
Next
End With
wbQuelle.Close Savechanges:=False
Next
End If
End With
End Sub
Function fncHerstellerKST(strText As String) As String
'Text von Kostenstellen-Nummer aus Text isolieren
'Kostenstellen werden als Text in Zellen eingetragen
fncHerstellerKST = strText
If InStr(1, strText, " ") > 0 Then 'leerzeichen vorhanden
fncHerstellerKST = "'" & Left(strText, InStr(1, strText, " ") - 1)
Else
If IsNumeric(strText) Then
fncHerstellerKST = "'" & strText
End If
End If
End Function


Anzeige
AW: oT "Frage noch offen"
17.10.2008 13:42:00
Reptil
..... franz, du bist der beste : )
vielen vielen vielen dank : )
ja, mit dem jahr hast du natürlich recht, da stimmt die zahl nicht
JUHUU *freu*

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige