|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
09.11.2010 16:15:06 |
Niklas |
|
|
|
09.11.2010 16:41:59 |
Severus |
|
|
|
09.11.2010 16:49:26 |
Niklas |
|
|
|
09.11.2010 17:21:10 |
Severus |
|
|
|
09.11.2010 17:49:30 |
Niklas |
|
|
|
09.11.2010 18:22:26 |
Severus |
|
|
|
09.11.2010 18:35:41 |
Niklas |
|
|
 Aw:Übersichtsdatei |
10.11.2010 06:53:47 |
Severus |
|
|
|
10.11.2010 14:50:57 |
Niklas |
|
|
|
10.11.2010 16:03:37 |
Severus |
|
|
|
10.11.2010 17:34:25 |
Niklas |
|
|
|
10.11.2010 18:00:26 |
Severus |
|
|
|
10.11.2010 19:05:39 |
Niklas |
|
|
|
10.11.2010 19:26:15 |
Severus |
|
|
|
10.11.2010 19:43:24 |
Niklas |
|
|
Von:
Severus |
Datum:
10.11.2010 06:53:47 |
Views:
1155 |
Rating:
|
Antwort:
|
Thema:
Aw:Übersichtsdatei |
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 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
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 |
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
09.11.2010 16:15:06 |
Niklas |
|
|
|
09.11.2010 16:41:59 |
Severus |
|
|
|
09.11.2010 16:49:26 |
Niklas |
|
|
|
09.11.2010 17:21:10 |
Severus |
|
|
|
09.11.2010 17:49:30 |
Niklas |
|
|
|
09.11.2010 18:22:26 |
Severus |
|
|
|
09.11.2010 18:35:41 |
Niklas |
|
|
Aw:Übersichtsdatei |
10.11.2010 06:53:47 |
Severus |
|
|
|
10.11.2010 14:50:57 |
Niklas |
|
|
|
10.11.2010 16:03:37 |
Severus |
|
|
|
10.11.2010 17:34:25 |
Niklas |
|
|
|
10.11.2010 18:00:26 |
Severus |
|
|
|
10.11.2010 19:05:39 |
Niklas |
|
|
|
10.11.2010 19:26:15 |
Severus |
|
|
|
10.11.2010 19:43:24 |
Niklas |
|
|