Severus schrieb am 10.11.2010 19:26:15:
Niklas schrieb am 10.11.2010 19:05:39:
Severus schrieb am 10.11.2010 18:00:26:
Niklas schrieb am 10.11.2010 17:34:25:
Severus schrieb am 10.11.2010 16:03:37:
Niklas schrieb am 10.11.2010 14:50:57:
Severus schrieb am 10.11.2010 06:53:47:
Als erstes in der Entwicklungsumgebung im Menü "Extras->Verweise"
einen Verweis auf die "Microsoft Scripting Runtime" setzen.
Code:
Sub Eintragen()
Dim FSO As New Scripting.FileSystemObject
Dim Ordner As Scripting.Folder
Dim DateiListe As Scripting.Files
Dim Datei As Scripting.File
Dim strDatei As String
Dim SpaltenVerschub As Long
Dim ZeilenVerschub As Long
With ThisWorkbook
With ActiveSheet
.Range(.Cells(2, 1), .Cells(.Range("A65536").End(xlUp).Row, 6)).Select
Selection.Clear
.Range("A2").Select
ZeilenVerschub = -1
Set Ordner = FSO.GetFolder("C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig")
If Ordner Is Nothing Then Exit Sub
Set DateiListe = Ordner.Files
If DateiListe Is Nothing Then Exit Sub
For Each Datei In DateiListe
SpaltenVerschub = 0
strDatei = Datei.Name
If strDatei = ThisWorkbook.Name Then GoTo Weiter
If InStr(1, UCase(Right(Datei.Name, 4)), "XLS", vbBinaryCompare) <> 0 Then
'Nächste Zeile
ZeilenVerschub = ZeilenVerschub + 1
'Spalte A
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$A$2"
SpaltenVerschub = SpaltenVerschub + 1
'Spalte B
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$B$2"
SpaltenVerschub = SpaltenVerschub + 1
'Spalte C
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$A$4"
SpaltenVerschub = SpaltenVerschub + 2
'Spalte E
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$AH$1"
SpaltenVerschub = SpaltenVerschub + 1
'Spalte F
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$AI$1"
End If
Weiter:
Next
End With
End With
Set DateiListe = Nothing
Set Ordner = Nothing
End Sub
Der Code löscht immer die alten Einträge, bevor er neue Schreibt, damit nicht die Dateien doppelt drinstehen.
Wichtig: Hier ist vorausgesetzt, daß alle Dateien ein Arbeitsblatt "Kunden" haben, da hier ja keine manuelle Eingabe erfolgt und das Programm nicht nach anderen Arbeitsblättern sucht. Allerdings bietet Excel/VBA im Falle, daß "Kunden" fehlt, die vorhandenen Arbeitsblätter zur Auswahl in einem Dialog an.
Severus
Hallo Severus,
dass klappt soweit schon super, er trägt alle Daten auch ein, allerdings erhalte ich den Fehler: "Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler" und bei wiederholtem ausführen des Codes wird in der ersten Zeile alles aus A bis F gelöscht.
Beim Debuggen wird:
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$A$2" markiert.
vielen Dank schon einmal.
Grüße,
Niklas
Mit
.Range(.Cells(2, 1), .Cells(.Range("A65536").End(xlUp).Row, 6)).Select
Selection.Clear
wird, wie gesagt alles ab Zelle A2 gelöscht und dann neu eingetragen. Sonst würde ja alles wieder und wieder eingrtagen werden.
Den Laufzeitfehler kann ich von hier natürlich nicht nachvollziehen. Da ja alle vorherigen Werte eingetragen werden müßte ich das selbst an Deinem PC sehen, weil das von allem möglichen kommen kann.
Ich kann nur empfehlen, den Code mit F8 schrittweise auszuführen und dabei immer die Variablen zu kontrollieren, ob eine davon leer ist oder einen unzulässigen Wert annimmt. Mehr geht von hier leider nicht.
Zu prüfen wäre auch, ob außer den "Kunden"-Dateien auch andere im genannten Verzeichnis sind. z.B. die hier verwendete Übersichtsdatei! Die würde dann ja auch aufgerufen und würde einen Verweis auf sich selbst setzen. Das geht dann natürlich nicht. Sollte das der Fall sein die Übersichtsdatei woandershin verschieben oder den Code wie oben abändern.
Alles andere mußt Du leider selber suchen!
Severus
Hallo Severus,
das Problem war, wie von dir schon vermutet, dass die Übersichtsdatei sich in dem Ordner befindet.
Jetzt funktioniert es auch super.
Ist es vielleicht noch möglich, dass in der Spalte G der Übersichtsdatei automatisch ein Button erscheint, welcher die Datei öffnet von der die Werte stammen?
Also das z.B. in der zweiten Zeile der Kunde Max Müller incl. dessen Daten steht und wenn ich auf den besagten Button in Spalte G klicke die Excel Datei von Max Müller geöffnet wird?
vielen lieben Dank Dir.
Grüße,
Niklas
Ergänze den Code:
'Spalte F
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).Formula = "='C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\[" & strDatei & "]Kunden'!$AI$1"
SpaltenVerschub = SpaltenVerschub + 1
'Spalte G
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub)= "C:\Dokumente und Einstellungen\Administrator\Desktop\Fertig\" & strDatei
Und erstelle auf dem Arbeitsblatt der Übersichtsdatei mit der Steuerelement - Toolbox einen Command_Button
Als Code hinterlegst Du
Private Sub CommandButton1_Click()
Dim DName As String
DName = Selection
If Instr(1, DName, ":\", vbBinaryCompare) <> 0 _
And Instr(1, UCase(DName), ".XLS", vbBinaryCompare) <> 0 Then
Workbooks.Open DName
Else
MsgBox "Keine Datei ausgewählt!", vbCritical, "Fehler..."
End If
End sub
Dann setzt Du in die Spalte G den Cursor und klickst auf den Button. Dann öffnet sich die Datei, deren Name jetzt in G eingetragen ist.
Severus
Hallo Severus,
das klappt auch super! vielen lieben Dank!
geht es vielleicht auch, dass die Datei geöffnet wird, wenn ich die Eingabe in Spalte A markiere und dann auf den Button drücke?
Denn im Moment steht in Spalte A der Name und in Spalte G der komplette Dateipfad.
Und ein klitze kleines Problem habe ich noch, die Werte in Spalte E und F werden momentan nicht als € ausgegeben obwohl die Quellwerte € sind.
Danke Dir!
Grüße,
Niklas
Du kriegst auch nicht genug, oder?
mach aus
DName = Selection
DName = Selection.EntireRow.Columns("G")
dann ist es wurst welche Zelle in der Zeile Du markierst.
Und für die Formatierung fügst Du zu den Codezeilen für E unf F ein
ActiveCell.Offset(ZeilenVerschub, SpaltenVerschub).NumberFormat = "#,##0.00 $"
dazu.
Ich hoffe Du bist jetzt zufrieden. Sonst laß ich mir von Deinem Chef Dein Gehalt überweisen!
Severus
Haha :)
vielen vielen Dank Dir!
Es funktioniert echt super, ich bin begeistert!
Ich bin erst Schüler, aber du kannst meine Lehrer gerne bitten, dir mein "Gehalt" zu überweisen :)
LG
Niklas |