Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
684to688
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datenblätter zusammenfassen

Datenblätter zusammenfassen
19.10.2005 14:58:02
Thomas
Hallo zusammen!
Mir stellt sich folgendes Problem:
Ich habe 10 Ordner (Regionen) mit jeweils mehreren Excel-Dateien (jeweils 1 pro Gemeinde), diese haben wiederum mehrere Mappen (jeweils 1 pro Zone). Jede Mappe ist ein standardisiertes und bereits ausgefülltes Aufnahmeblatt mit gewissen Kriterien. D.h. jedes Kriterium ist jeweils in der selben Zelle platziert (z.B. C3).
Um die Daten effektiv auswerten zu können, möchte ich ein einziges Excel-Blatt, in dem alle Daten quasi als Rohdaten zusammengefasst werden.
Gibt es eine Möglichkeit, das Ganze mit einer Formel oder einem schlauen Makro zu lösen? Ich bin jetzt mühsam am Makros schreiben, die individuell lauten müssen (Regions-, Gemeinde- und Zonennamen).
Pro Zeile sollte eine Gemeinde erscheinen, in den Spalten sollten die dazugehörigen Kriterien sein.
Beste Grüsse und vielen Dank für Eure Hilfe
Thomas

26
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenblätter zusammenfassen
19.10.2005 15:13:37
Thomas
Hallo nochmals!
Hier ist verständnishalber noch ein Link wie die Tabelle am Ende aussehen sollte.
https://www.herber.de/bbs/user/27638.xls
Grüsse
Thomas
AW: Datenblätter zusammenfassen
19.10.2005 20:43:13
Rolf
Hallo Thomas,
gib doch mal in der Recherche ein: "Tabellenblätter zusammenfassen" -
da bekommst du ca. 200 Threadhinweise.
fG
Rolf
AW: Datenblätter zusammenfassen
20.10.2005 07:58:20
Thomas
Hallo Rolf
Danke für den Hinweis. Leider konnte ich nichts direkt vergleichbares finden. Zudem hab ich zu wenig Ahnung von Makros. Wie müsste so eins aussehen, dass alle Ordner, alle Mappen und alle darin enthaltenen Blätter nach z.B. der Zelle C3 durchsucht werden? Kannst Du mir da weiterhelfen?
Beste Grüsse und danke im Voraus
Thomas
Anzeige
AW: Datenblätter zusammenfassen
20.10.2005 08:45:28
Rolf
Hallo Thomas,
lade doch mal ein abgespecktes Beispiel hoch,
wie's aussehen soll.
fG
Rolf
AW: Datenblätter zusammenfassen
20.10.2005 09:19:33
Thomas
Hallo Rolf
Ich habe die Datei hier hochgeladen:
https://www.herber.de/bbs/user/27660.xls
In diese Liste sollen alle Dateien und Mappen zeilenweise eingelesen werden. Habe zudem ein Beispielsmakro eingefügt (dieses muss ich immer individuell anpassen). xxx = Gemeindename (Dateiname) und yyy = Zonenname (Blattname). Diese Makros hänge ich jeweils alle aneinander.
Um es zu vereinfachen, kann man davon ausgehen, dass alle Dateien im selben Ordner sind.
Beste Grüsse und Danke im Voraus
Thomas
Anzeige
Zonenname
20.10.2005 09:43:56
Rolf
Hallo Thomas,
der Zonenname "yyy" ist immer der Name des 1. Tabellenblatts
der jeweiligen Datei?
fg
Rolf
AW: Zonenname
20.10.2005 09:56:51
Thomas
Hallo Rolf
Der Zonenname "yyy" ist in jedem Blatt wieder anders.
Beispiel:
Dateiname(xxx): Bülach
Blattname(yyy1): Bülach_K1
Blattname(yyy2): Bülach_K2
Blattname(yyy3): Bülach_K3
Die Endung lautet nicht immer zwingend _K1 etc. sonder kann auch _KA, _KB usw. lauten. Es kann auch vorkommen, dass der Blattname dem Dateinamen entspricht (falls nur 1 Blatt vorhanden).
Somit musste ich für jede Zone jeder Gemeinde ein individuelles Makro schreiben. Ist zeitaufwändig und nicht besonders elegant.
Beste Grüsse
Thomas
Anzeige
weitere Nachfragen
20.10.2005 09:58:09
Rolf
Hallo Thomas,
a. müssen die Daten verknüpft werden,
oder reichen die Zellwerte der jeweiligen Datei?
b. warum erfolgt die Zeileneinfügung?
fG
Rolf
AW: weitere Nachfragen
20.10.2005 10:12:34
Thomas
Hallo Rolf
a. Daten müssen verknüpft sein, da die Blätter evtl. von Zeit zu Zeit angepasst werden müssen. Es würde aber auch reichen, wenn die Zellwerte mittels Makro jeweils aktualisiert/erneuert werden können.
b. Es geht darum, die Daten gesamthaft auszuwerten und zu vergleichen und nach bestimmten Kriterien zu ordnen.
Beste Grüsse
Thomas
Testversion
20.10.2005 10:57:30
Rolf
Hallo Thomas,
hier mal eine erste Testversion.
Schau mal, wo's noch hapert.
fG
Rolf
Option Explicit
Dim WS As Worksheet
'Startprozedur

Sub start_GetValues()
'(C) Rolf Beißner 10.2005
Dim verz As String
verz = GetOrdner
ChDir verz
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets(1)
ShowFileList (verz)
End Sub

'Excel-Dateien öffnen

Sub ShowFileList(folderspec)
Dim exapp As Object, fs As Object, f As Object, fc As Object, fl As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
Set exapp = GetObject(folderspec & "\" & fl.Name)
Call daten_übernehmen(exapp)
Call schliessen(fl.Name)
End If
Next
End Sub

'Datenübernahme

Sub daten_übernehmen(qfile)
Dim zarr(), sarr()
Dim i%, n%, m%
Dim qsheet As Worksheet
Set qsheet = qfile.Sheets(1)
zarr = Array(3, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24)
sarr = Array(2, 4, 4, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 5)
n = UBound(zarr)
m = WS.Cells(65536, 1).End(xlUp).Row + 1
Set qsheet = qfile.Sheets(1)
For i = 1 To n
WS.Cells(m, i) = qsheet.Cells(zarr(i), sarr(i))
Next
End Sub

'Schließprozedur

Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub

'Ordnerauswahl

Function GetOrdner(Optional ByVal def = "")
Dim objShell As Object, objfolder As Object
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "Bitte einen Ordner wählen", 0, def)
If objfolder Is Nothing Then End
GetOrdner = objfolder.Self.Path
End Function

Anzeige
AW: Testversion
20.10.2005 11:16:02
Thomas
Hallo Rolf
Besten Dank für Deine Mühe!
Leider bin ich nur soweit gekommen, dass ich einen Ordner wählen konnte. Nachher ist der Explorer abgestürzt, d.h. er stürzt immer wieder ab... Folgende Fehlermeldung erscheint:
"Die Anweisung in "0x780e5769" verweist auf Speicher in "0x0d0afde4". Der Vorgang "read" konnte nicht auf dem Speicher durchgeführt werden."
Beste Grüsse
Thomas
Absturz Explorer
20.10.2005 11:50:00
Rolf
Hallo Thomas,
klingt nach Zugriffsverweigerung -
passiert das auch, wenn du auf ein lokales LW zugreifst?
fG
Rolf
AW: Absturz Explorer
20.10.2005 12:06:25
Thomas
Hallo Rolf
Ja, leider passiert es auch von einem lokalen Laufwerk aus. Wenn ich das Makro starte, kommt die Ordnerwahl und nach ca. 10 Sekunden die selbe Fehlermeldung wie vorhin beschrieben.
Beste Grüsse und Dank
Thomas
Anzeige
AW: Absturz Explorer
20.10.2005 12:16:51
Rolf
Hallo Thomas,
da ist aus der Ferne nicht viel zu machen,
da's bei mir ja unter Office2003/XP läuft,
und ich den Fehler nicht reproduzieren kann.
Geh den Code mal schrittweise durch und schau,
bis zu welcher Zeile er kommt.
Auf alle Fälle habe ich die Frage mal auf offen gesetzt -
sorry.
fG
Rolf
AW: Absturz Explorer
20.10.2005 12:36:07
Thomas
Hallo Rolf
Ich werde es auf jeden Fall bei mir zu Hause am PC nochmals durchlaufen lassen. Evtl. klappts ja dort!
Vorerst vielen herzlichen Dank für die prompte Hilfe! Ich werde mich in Zukunft auch mal in die VBA-Thematik einlesen müssen! Ohne das ist, wie ich sehe, von meiner Seite her nicht viel zu machen.
Beste Grüsse und bereits jetzt ein schönes Wochenende
Thomas
Anzeige
AW: Absturz Explorer
20.10.2005 12:43:55
Rolf
Hallo Thomas,
gib bitte auf jeden Fall noch mal eine
Rückmeldung an meine priv. Mailadresse
(rolf.name mit "ss"@t-online.de).
Dir auch ein schönes WE + viel Erfolg
Rolf
AW: Absturz Explorer
21.10.2005 07:48:07
Thomas
Hallo Rolf
Hat zu hause leider auch nicht funktioniert; jdeoch ohne Absturz. Ist das Mail angekommen?
Gruss
Thomas
AW: Absturz Explorer
21.10.2005 09:14:20
Rolf
Hallo Thomas,
Mail ist angekommen, aber dem Screenshot kann ich nichts entnehmen.
Wir nehmen jetzt mal die möglicherweise kritischen Befehle raus,
und schauen, was passiert.
Das Verzeichnis "G:\Ortsbildschutz\Knonaueramt" sollte für
den Test nur wenige Dateien enthalten.
Der schrittweise Test (debuggen) geht so:
Du schaltest mit ALT+F11 in die Entwicklungsumgebung,
setzt den Cursor auf "start_copy_values()",
und drückst dann sukzessive F8.
Wenn du das Lokalfenster aktiviert hast (Ansicht -Lokalfenster),
kannst du während des Debuggens die Variablenentwicklung verfolgen.
hG
Rolf
Option Explicit
Dim WS As Worksheet
'Startprozedur

Sub start_copy_values()
'(C) Rolf Beißner 10.2005
Dim verz As String
'verz = GetOrdner
verz = "G:\Ortsbildschutz\Knonaueramt"
ChDir verz
'Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets(1)
ShowFileList (verz)
End Sub

'Excel-Dateien öffnen

Sub ShowFileList(folderspec)
Dim exapp As Object, fs As Object, f As Object, fc As Object, fl As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
'Set exapp = GetObject(folderspec & "\" & fl.Name)
Set exapp = Workbooks.Open(folderspec & "\" & fl.Name)
Call daten_übernehmen(exapp)
Call schliessen(fl.Name)
End If
Next
End Sub

'Datenübernahme

Sub daten_übernehmen(qfile)
Dim zarr(), sarr()
Dim i%, n%, m%
Dim qsheet As Worksheet
zarr = Array(3, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24)
sarr = Array(2, 4, 4, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 5)
n = UBound(zarr)
m = WS.Cells(65536, 1).End(xlUp).Row + 1
Set qsheet = qfile.Sheets(1)
For i = 1 To n
WS.Cells(m, i) = qsheet.Cells(zarr(i), sarr(i))
Next
End Sub

'Schließprozedur

Sub schliessen(wind)
Windows(wind).Visible = True
'Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub

'Ordnerauswahl

Function GetOrdner(Optional ByVal def = "")
Dim objShell As Object, objfolder As Object
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "Bitte einen Ordner wählen", 0, def)
If objfolder Is Nothing Then End
GetOrdner = objfolder.Self.Path
End Function

Anzeige
AW: Absturz Explorer
21.10.2005 10:01:13
Thomas
Hallo Rolf
Besten Dank nochmals!
Noch eine letzte Frage: Wir mussten die Daten umplatzieren. Der Pfad lautet neu:
C:\Dokumente und Einstellungen\B275PME\Desktop\Ortsbild Test
Diese Datei ist nur zum Testen. Wie könnte ich den Pfad selber definieren? Durch die Pfadänderung bedingt, konnte ich das Makro leider noch nicht testen.
Beste Grüsse
Thomas
Geht doch
21.10.2005 10:10:20
Thomas
Hallo Rolf
Entschuldige, habe es doch noch selber geschafft, den richtigen Pfad einzugeben. Folgende Probleme sind noch offen:
- Alle Eingaben sind eine Zelle zu weit links
- Gemeindename erscheint nicht
- Es wird nur das 1. Blatt eingelesen
- Für jede Gemeinde muss ich das Makro einzeln starten.
Beste Grüsse
Thomas
Anzeige
AW: Geht doch
21.10.2005 10:53:26
Rolf
Hallo Thomas,
a + b werden gelöst durch "Option Base 1"
c habe jetzt eine Schleife eingebaut, die alle Blätter der Mappe durchsieht
d alle Dateien im angegebenen Ordner werden abgearbeitet
(testweise kannst du ja mal alle Gemeinden in einen Ordner kopieren"
hG
Rolf
Option Explicit
Option Base 1
Dim WS As Worksheet
'Startprozedur

Sub start_copy_values()
'(C) Rolf Beißner 10.2005
Dim verz As String
verz = "C:\Dokumente und Einstellungen\B275PME\Desktop\Ortsbild Test"
ChDir verz
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets(1)
ShowFileList (verz)
End Sub

'Excel-Dateien öffnen

Sub ShowFileList(folderspec)
Dim exapp As Object, fs As Object, f As Object, fc As Object, fl As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
'Set exapp = GetObject(folderspec & "\" & fl.Name)
Set exapp = Workbooks.Open(folderspec & "\" & fl.Name)
Call daten_übernehmen(exapp)
Call schliessen(fl.Name)
End If
Next
End Sub

'Datenübernahme

Sub daten_übernehmen(qfile)
Dim zarr(), sarr()
Dim i%, n%, m%
Dim qsheet As Object
zarr = Array(3, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24)
sarr = Array(2, 4, 4, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 5)
n = UBound(zarr)
For Each qsheet In qfile.Sheets
m = WS.Cells(65536, 1).End(xlUp).Row + 1
For i = 1 To n
WS.Cells(m, i) = qsheet.Cells(zarr(i), sarr(i))
Next
Next
End Sub

'Schließprozedur

Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub

Anzeige
Genial!!!
21.10.2005 11:05:35
Thomas
Hallo Rolf
Einfach genial! Jetzt klappt es einwandfrei!
Allerletzte Unstimmigkeit:
Es werden nur die ersten 5 Gemeinden (Aber mit allen Blättern) in die Liste eingefügt.
Beseten Dank und Gruss
Thomas
AW: Genial!!!
21.10.2005 11:24:41
Rolf
Hallo Thomas,
da sind wir doch schon ein gutes Stück weiter.
Es sollten ALLE Dateien eines Ordners abgearbeitet werden.
Im Zweifel musst du jetzt mal debuggen.
hG
Rolf
PS
Für heute verabschiede ich mich vom Forum,
solltest du noch Probleme haben, bitte an meine priv. Mailadresse.
AW: Genial!!!
21.10.2005 11:34:43
Thomas
Hallo Rolf
Somit vorerst 1000 Dank für deine prompte und äusserst nützliche Hilfe! Ohne Dein Supermakro würde jetzt viel Arbeit anstehen! Einfach genial was Du da Programmiert hast! Gratuliere!
Beste Grüsse und nun definitiv ein schönes Wochenende!
Thomas
PS: Werde mich als nächstes auch mit VBA befassen!
AW: Genial!!!
21.10.2005 11:54:05
Thomas
Hallo Rolf
Ich hab nun das Ganze mit allen Gemeinden durchgespielt und jetzt hatts wunderbar geklappt!
Bin schlichtweg begeistert!
Nochmals herzlichen Dank!
Gruss
Thomas
AW: Geht doch
21.10.2005 11:03:21
Rolf
Hallo Thomas,
a + b werden gelöst durch "Option Base 1"
c habe jetzt eine Schleife eingebaut, die alle Blätter der Mappe durchsieht
d alle Dateien im angegebenen Ordner werden abgearbeitet
(testweise kannst du ja mal alle Gemeinden in einen Ordner kopieren"
hG
Rolf
Option Explicit
Option Base 1
Dim WS As Worksheet
'Startprozedur

Sub start_copy_values()
'(C) Rolf Beißner 10.2005
Dim verz As String
verz = "C:\Dokumente und Einstellungen\B275PME\Desktop\Ortsbild Test"
ChDir verz
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Sheets(1)
ShowFileList (verz)
End Sub

'Excel-Dateien öffnen

Sub ShowFileList(folderspec)
Dim exapp As Object, fs As Object, f As Object, fc As Object, fl As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
'Set exapp = GetObject(folderspec & "\" & fl.Name)
Set exapp = Workbooks.Open(folderspec & "\" & fl.Name)
Call daten_übernehmen(exapp)
Call schliessen(fl.Name)
End If
Next
End Sub

'Datenübernahme

Sub daten_übernehmen(qfile)
Dim zarr(), sarr()
Dim i%, n%, m%
Dim qsheet As Object
zarr = Array(3, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24)
sarr = Array(2, 4, 4, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 5)
n = UBound(zarr)
For Each qsheet In qfile.Sheets
m = WS.Cells(65536, 1).End(xlUp).Row + 1
For i = 1 To n
WS.Cells(m, i) = qsheet.Cells(zarr(i), sarr(i))
Next
Next
End Sub

'Schließprozedur

Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige