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
GELÖST

Makro zum transponieren von Daten aus mehreren Dateien in eine Sammeldatei

Frage Microsoft Microsoft Office

Mitglied: Rio1980

Rio1980 (Level 1) - Jetzt verbinden

28.10.2010, aktualisiert 17:59 Uhr, 6178 Aufrufe, 10 Kommentare

Hallo allerseits,

da meine Kenntnisse mit VBA nicht wirklich ausgereift sind, hier mal mein Problem. Ich denke dass es über ein Makro zu realisieren ist, aber über das wie tappe ich noch im Dunkeln...

Ich hab eine Ansammlung von Dateien, die alle identisch aufgebaut sind, aus denen ich Daten (Werte, nicht die Formeln, vertikal angeordnet) in eine Excelsammeldatei transponoieren will (horizontale Anordnung).
In meiner Sammeldatei sind schon Daten erfasst, die um einige Werte aus den identischen Dateien ergänzt werden sollen. Ich habe mir das fogendermaßen vorgestellt:
In der Sammeldatei sind in der Spalte C (z.b Artikelnummern) eingetragen zu denen in den Spalten D-K Informationen eingetragen sind. Nun sollen also zu jedem Artikel ab der Spalte L die Daten ergänzt werden. In den Quelldateien ist immer in der Zelle B2 die Artikelnummer eingetragen und in den Zellen D5 - D10 die Werte (teilweise durch Formeln berechnet), die ich in meine Sammeldatei transponieren will. Das Makro sollte wie folgt vorgehen:

1. Schriit: Prüfen ob in meiner Sammeldatei z.B. in Zelle C5 eine Artikel-Nr vorhanden ist, wenn ja > 2. Schritt / wenn nein > Ende
2. Schritt: Prüfen ob Zelle L5 leer ist. wenn nein > Schritt 1 für die nächste Zeile (C6) / wenn ja > 3. Schritt
3. Schritt: Prüfen ob zu der Artikel-Nr aus z.B Zelle C5 eine Quelldatei existiert. Also prüfen ob in einer der .xls Quelldateien meines Ordners in der Zelle B2 die gesuchte Artikel-Nr eingetragen ist. wenn nein > Schritt 1 für die nächste Zeile / wenn ja > 4. Schritt
4. Schritt: Transponieren der Daten aus den Zellen D5-D10 aus der gefundenen Datei in meine Sammeldatei in die Zellen L5-Q5 (Zeile der geprüften Artikel-Nr.) danach wieder 1. Schritt

Wie schon gesagt, denke ich dass es machbar ist (falls ich mich irre lasse ich mich da gerne eines besseren belehren , nur bekomme ich das im VBA nicht in den Griff...

Falls mir jemand helfen kann schon mal vielen Dank im Voraus!

Viele Grüße
Rio
Mitglied: bastla
28.10.2010 um 17:35 Uhr
Hallo Rio1980!

Ich frage gleich mal gar nicht, weshalb es die Struktur mit mehreren gleich aufgebauten Dateien gibt ...

... aber das Mengengerüst könntest Du vielleicht einmal beschreiben - insbesondere: Passen alle relevanten Daten in den Arbeitsspeicher?

Und: Wie sieht den Dein Code bisher aus? In Deinem Pseudocode hätte ich jedenfalls am Ende des Schrittes 4 noch eine Erhöhung der Zeilennummer erwartet, ehe wieder Schritt 1 aufgerufen wird ...

Grüße
bastla
Bitte warten ..
Mitglied: Rio1980
28.10.2010 um 17:52 Uhr
Hallo Bastla!

zu deiner ersten "nicht" gestellten Frage: Wenn mehrere Abteilungen eines Unternehmens arbeiten, weiß oft die eine Hand nicht was die andere tut... :o)

Was das Mengengerüst angeht: Im Moment sind in der Sammeldatei ca 1500 Datensätze, Quelldateien gibt es an die 200, aber von beidem werden es täglich mehr...
Ich denke dass es klappen sollte, wenn nicht müsste ich das ganze vereinfachen, was ich aber nur ungern machen würde, da der Automationsvorgang erheblich gestört wäre.

Viele Grüße
Rio
Bitte warten ..
Mitglied: bastla
28.10.2010 um 17:58 Uhr
Hallo Rio1980!

Die Frage nach den Mengen hatte als Hintergrund Performanceüberlegungen - für jeden nicht kompletten Datensatz der Sammeltabelle im Schnitt 100 Dateien öffnen zu müssen würde ich vermeiden wollen - daher die Frage, ob sich die Werte aus den 200 Dateien in einem Vorverarbeitungsschritt auslesen und zB in ein einem "Dictionary" im Arbeitsspeicher unterbringen ließen - oder zumindest in einer einzigen Temporärdatei ...

Grüße
bastla
Bitte warten ..
Mitglied: Rio1980
28.10.2010 um 18:12 Uhr
Hallo Bastla!

Da sowohl die Sammeldatei ständig weiter ergänzt wird als auch immer weitere Quelldateien angelegt werden finde ich das anlegen einer Temporärdatei oder eines "Dictionary" nicht zweckmäßig, da diese beim erneuten ausführen des Makros neu angelegt werden müssten. Zumal nach einem Auslesen der benötigten Daten aus einer Quelldatei diese wieder geschlossen werden kann, da sich die Artikel-Nr in der Sammeldatei nicht wiederholen und die entsprechende Quelldatei somit vorerst nicht weiter gebraucht wird .

Viele Grüße
Rio
Bitte warten ..
Mitglied: bastla
28.10.2010 um 18:57 Uhr
Hallo Rio1980!

Wie wird denn die Quelldatei gefunden? Soferne sich der Name aus der Artikelnummer ableiten lässt, hast Du natürlich Recht damit, dass nicht alle Dateien eingelesen werden müssen -
prüfen ob in einer der .xls Quelldateien meines Ordners in der Zelle B2 die gesuchte Artikel-Nr eingetragen ist.
hatte sich für mich allerdings danach angehört, als müsste die Quelldatei erst gesucht werden ...

Für diesen Fall hatte ich zwischenzeitlich etwa folgenden (aus der Sammeldatei zu startenden) Ansatz (noch eher schütter kommentiert ) gebastelt (der sich natürlich auch auf das gezielte Öffnen einer bestimmten Datei wird anpassen lassen):
01.
Sub CollectAndTrans() 
02.
Ordner = "D:\Test" 
03.
 
04.
Dim A() 
05.
Set d = CreateObject("Scripting.Dictionary") 
06.
Set fso = CreateObject("Scripting.FileSystemObject") 
07.
 
08.
For Each File In fso.GetFolder(Ordner).Files 
09.
    If UCase(fso.GetExtensionName(File.Name)) = "XLSX" Then 
10.
        Set WB = Workbooks.Open(File.Path) 
11.
        ReDim A(5) 'Array passend dimensionieren und dabei löschen 
12.
        i = 0 'Index für Array initialilsieren 
13.
        For Each Cell In WB.Worksheets(1).Range("D5:D10") 
14.
            A(i) = Cell.Value 'Zellwert in Array übernehmen 
15.
            i = i + 1 
16.
        Next 
17.
        'Jede ArtNr kommt nur einmal vor, daher keine Prüfung des Keys erforderlich - 
18.
        'Artikel kann dem Dictionary hinzugefügt werden 
19.
        d.Add CStr(WB.Worksheets(1).[B2]), A 
20.
        WB.Close 
21.
    End If 
22.
Next 
23.
 
24.
R = 5 'ab Zeile 5 der Sammeltabelle 
25.
ArtNr = CStr(Cells(R, "C")) 
26.
Do Until ArtNr = "" 'bis keine Artikeldaten mehr gefunden werden 
27.
    If Cells(R, "L") = "" Then 
28.
        If d.Exists(ArtNr) Then Cells(R, "L").Resize(1, 6).Value = d.Item(ArtNr) 
29.
    End If 
30.
    R = R + 1 
31.
    ArtNr = CStr(Cells(R, "C")) 
32.
Loop 
33.
End Sub
Falls die Excelversion < 2007 (und daher die Sammeldatei als ".xls" und nicht als ".xlsm" gespeichert) ist, sollte die Sammeldatei nicht im vorgegebenen Ordner liegen (oder gezielt anhand eines weiteren "If" von der Verarbeitung ausgeschlossen werden).

Grüße
bastla
Bitte warten ..
Mitglied: Rio1980
05.11.2010 um 16:40 Uhr
Hallo Bastla!

Vielen Dank schon mal für die schnelle Hilfe! Leider habe ich das Makro so nicht zum laufen bekommen. Beim Ausführen einer Testdatei ist der Pc zwar kurz am arbeiten, es werden aber keine Daten übertragen. Ich habe den Quelltext so übernommen und nur den Ordnerpfad in der zweiten Zeile angepasst. Oder muss ich nochwas anpassen was ich übersehen habe?

Wie du schon selber erwähnt hast, ist das es nur \"schütter\" kommentiert, sodass ich einige Vorgänge nicht ganz nachvollziehen kann. Mir ist nicht ganz klar, wie das Makro die richtige Datei findet, die zur Artk-Nr passt und wie es erkennt in welche Zeile (muss die Zeile der geprüften Artikel-Nr sein) es die übernommenen Daten in die Zellen L-Q der entsprechenden Zeile eingügen soll. Das Problem hierbei ist, dass nicht zu jeder Art-Nr in der Sammeldatei eine Quelldatei existiert, sodass es zwischendurch Zeilen geben wird, in die keine Daten übernommen werden sollen.

Zu deiner Frage: Die Dateinamen der Quelldateien Setzen sich wie folgt zusammen: \"Art-Nr\"_\"Datum\".xls. Demnach ist die Artikel-Nr schon im Namen der Datei ersichtlich.

Viele Grüße
Rio
Bitte warten ..
Mitglied: bastla
05.11.2010 um 18:57 Uhr
Hallo Rio1980!
Oder muss ich nochwas anpassen was ich übersehen habe?
Zeile 9?
Mir ist nicht ganz klar, wie das Makro die richtige Datei findet, die zur Artk-Nr passt und wie es erkennt in welche Zeile (muss die Zeile der geprüften Artikel-Nr sein) es die übernommenen Daten in die Zellen L-Q der entsprechenden Zeile eingügen soll.
Die Schleife in den Zeilen 8 bis 22 liest aus allen ".xlsx"-Dateien des vorgegebenen Ordners die Werte aus D5:D10 in ein Array ein und legt dieses im Dictionary mit dem Wert von B2 als Schlüssel ab.

In der zweiten Schleife wird die Artikelnummer aus Spalte C gelesen und als Schlüssel verwendet, um aus dem Dictionary (wenn denn ein Eintrag existiert - siehe Zeile 28) die zwischengespeicherten Werte auszulesen und ab Spalte L einzutragen.

Es wird also, abweichend von Deinem Algorithmus, nicht anhand der Artikelnummer die Datei gesucht und dann das Auslesen der Werte vorgenommen, sondern nach den bereits im ersten Schritt erfassten Daten (aller Dateien) im Dictionary gesucht - soferne auch immer alle Dateien in der Sammeldatei repräsentiert sind, ergäbe sich daraus kein Performance-Nachteil.

Hinsichtlich der Aktualisierungen und eines zu befürchtenden "Veraltens" der Daten im Dictionary wäre noch anzumerken, dass diese Datensammlung (im "Dictionary") immer neu erstellt und nur im Arbeitsspeicher abgelegt wird - daher würden nur Dateien, welche erst nachdem das Makro im Ablauf die Zeile 23 erreicht hat, hinzugefügt wurden, nicht berücksichtigt ...

Grüße
bastla
Bitte warten ..
Mitglied: Rio1980
08.11.2010 um 16:07 Uhr
Hallo Bastla!

Vielen Dank! Die Vorgehensweise des Makros ist mir nun klar, aber anscheinend der Aufbau immer noch nicht so ganz. Habe das Makro nochmal getestet, bekomme aber keine Werte in meine Test-Sammeldatei übernommen. So sah das Makro beim Test aus.



Sub CollectAndTrans()
Ordner = "c:\test"

Dim A()
Set d = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each File In fso.GetFolder(Ordner).Files
If UCase(fso.GetExtensionName(File.Name)) = "XLX" Then
Set WB = Workbooks.Open(File.Path)
ReDim A(10)
i = 0
For Each Cell In WB.Worksheets(1).Range("E8:E18")
A(i) = Cell.Value
i = i + 1
Next

d.Add CStr(WB.Worksheets(1).[B2]), A
WB.Close
End If
Next

R = 1
ArtNr = CStr(Cells(R, "C"))
Do Until ArtNr = ""
If Cells(R, "L") = "" Then
If d.Exists(ArtNr) Then Cells(R, "L").Resize(1, 6).Value = d.Item(ArtNr)
End If
R = R + 1
ArtNr = CStr(Cells(R, "C"))
Loop
End Sub


Ich habe einen Testordner angelegt, in den ich einige Quelldateien kopiert habe und eine Test-Sammeldatei erstellt, in der ich in den Zellen C 1-5 Art-Nummern eingetragen habe, die mit den Art-Nummern in den Test-Quelldateien in der Zelle B2 übereinstimmen. In Zeiler 9 habe ich nur das "XLSX" in "XLX" abgeändert, oder muss muss da das (File.Name) geändert werden? Wenn ja, was muss da rein? Da ich 11 Werte aus den Quelldateien übernehmen möchte, habe ich das Array auf 10 gesetzt. In Zeile 28 müsste man es wohl auch auf 11 setzen, aber mit den eingegebenen "6" sollten ja eigentlich auch schon einige Werte übernommen worden sein!?

Ich wäre Dir echt dankbar wenn du da nochmal drüberschauen könntest und mir sagen könntest wo ich da den Fehler mache.

Viele Grüße
Rio
Bitte warten ..
Mitglied: bastla
08.11.2010 um 16:58 Uhr
Hallo Rio1980!

Hast Du wirklich "XLX"-Dateien? Ich wäre von "XLSX" oder "XLS" ausgegangen ...
In Zeile 28 müsste man es wohl auch auf 11 setzen
Was spricht dagegen, es gleich richtig zu machen? Das sollte sich auch mit
If d.Exists(ArtNr) Then Cells(R, "L").Resize(1, UBound(d.Item(ArtNr)) + 1).Value = d.Item(ArtNr)
automatisieren lassen.

Grüße
bastla

P.S.: Bitte poste Code unter Verwendung der entsprechenden Tags ...
Bitte warten ..
Mitglied: Rio1980
12.11.2010 um 15:48 Uhr
Hallo Bastla!

natürlich habe ich "xls" Dateien, weiß auch nicht wie ich auf "xlx" kam :o)
Das Makro funktioniert nun einwandfrei. Vielen Dank nochmal!

Viele Grüße
Rio
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
VB for Applications
gelöst Makro auf alle Dateien im Ordner (1)

Frage von mcandyyyyy zum Thema VB for Applications ...

Batch & Shell
gelöst Powershell: Dateien nach Version löschen in mehreren Ordnern (4)

Frage von ImmerKind zum Thema Batch & Shell ...

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

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

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 (14)

Frage von liquidbase zum Thema Windows Update ...