|
Tipp 0450
|
Dateinamen in Tabellenblatt ausgeben
|
 |
|
Autor/Einsender:
Datum: |
|
Angie
11.05.2005 |
|
| Entwicklungsumgebung: |
|
Excel 2000 |
|
|
|
In den hier folgenden Beispielen wurde für die Ermittlung der Arbeitsmappen im vorgegebenen
Verzeichnis die Funktion GetXLFiles() aus unserem Tipp
Dateien in vorgegebenen Verzeichnis ermitteln
verwendet. Der Code der Funktion ist hier nicht abgebildet, jedoch im Download-Beispiel
enthalten.
|
|
| Dateinamen inkl. Pfad in einer Spalte im Tabellenblatt ausgeben |
|
|
Damit die Dateinamen im Datenfeld in das Tabellenblatt ausgegeben werden können, müssen die
Daten im Datenfeld erst transponiert, also Zeilen und Spalten "vertauscht" werden.
|
|
Hier werden die Daten mit der Tabellenblattfunktion Transpose (Deutsche Bezeichnung
MTRANS) transponiert. Auf Grund der Begrenzung der Anzahl der Elemente, die mit der
Tabellenblattfunktion transponiert werden können, sollte die Tabellenblattfunktion nur bei
kleineren Datenmengen verwendet werden.
|
|
| |
Public Sub Demo_Aufruf_1()
Dim strPath As String
Dim astrXLFiles() As String
strPath = ThisWorkbook.Path
If Len(Dir$(strPath, vbDirectory)) > 0 Then
If GetXLFiles(astrXLFiles(), strPath, True) Then
With ActiveWorkbook.Worksheets(1)
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)) _
.Cells.Clear
.Cells(2, 1).Resize(UBound(astrXLFiles) + 1, 1).Value = _
Application.WorksheetFunction.Transpose(astrXLFiles)
End With
MsgBox CStr(UBound(astrXLFiles) + 1) & _
" Dateien wurden gefunden!", vbInformation
Erase astrXLFiles
Else
MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
vbCrLf & strPath & vbCrLf & "gefunden!", _
vbInformation, "VB-fun-Demo"
End If
Else
MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
"existiert nicht!", vbInformation, "VB-fun-Demo"
End If
End Sub
|
|
|
|
Das Ergebnis des folgenden Beispiels ist das selbe wie obiges Beispiel, jedoch mit dem
Unterschied, dass die Daten hier "zu Fuß" mithilfe eines 2. Datenfelds transponiert
werden. Die Geschwindigkeit der Code-Ausführung ist die selbe wie bei der Verwendung der
Tabellenblattfunktion Transpose, hat jedoch den Vorteil, dass größere Datenmengen
transponiert werden können.
|
|
| |
Public Sub Demo_Aufruf_2()
Dim strPath As String
Dim astrXLFiles() As String
Dim astrXLData() As String
Dim nFilesCnt As Long
Dim nFile As Long
strPath = ThisWorkbook.Path
If Len(Dir$(strPath, vbDirectory)) > 0 Then
If GetXLFiles(astrXLFiles(), strPath, True) Then
nFilesCnt = UBound(astrXLFiles)
ReDim astrXLData(nFilesCnt, 0)
For nFile = 0 To nFilesCnt
astrXLData(nFile, 0) = astrXLFiles(nFile)
Next
With ActiveWorkbook.Worksheets(1)
.Range(.Cells(2, 1), .Cells(.Rows.Count, _
.Columns.Count)).Cells.Clear
.Cells(2, 1).Resize(nFilesCnt + 1, 1).Value = astrXLData
End With
Erase astrXLData
Erase astrXLFiles
MsgBox CStr(nFilesCnt + 1) & " Dateien wurden gefunden!", _
vbInformation, "VB-fun-Demo"
Else
MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
vbCrLf & strPath & vbCrLf & "gefunden!", _
vbInformation, "VB-fun-Demo"
End If
Else
MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
"existiert nicht!", vbInformation, "VB-fun-Demo"
End If
End Sub
|
|
|
| Pfad und Dateinamen getrennt in zwei Spalten in Tabellenblatt ausgeben |
|
|
Zunächst werden Pfad und Dateiname der einzelnen Dateien ermittelt und in einem zweidimensionalen
Datenfeld zwischengespeichert, und anschließend in den Zellbereich eingefügt.
|
|
| |
Public Sub Demo_Aufruf_3()
Dim strPath As String
Dim astrXLFiles() As String
Dim astrXLData() As String
Dim nFilesCnt As Long
Dim nFile As Long
Dim strFileName As String
Dim strFile As String
strPath = ThisWorkbook.Path
If Len(Dir$(strPath, vbDirectory)) > 0 Then
If GetXLFiles(astrXLFiles(), strPath, True) Then
nFilesCnt = UBound(astrXLFiles)
ReDim astrXLData(nFilesCnt, 1)
For nFile = 0 To nFilesCnt
strFileName = astrXLFiles(nFile)
strFile = Dir$(strFileName)
astrXLData(nFile, 0) = Left$(strFileName, _
Len(strFileName) - Len(strFile))
astrXLData(nFile, 1) = strFile
Next
With ActiveWorkbook.Worksheets(1)
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)) _
.Cells.Clear
.Cells(2, 1).Resize(nFilesCnt + 1, 2).Value = astrXLData
End With
Erase astrXLData
Erase astrXLFiles
MsgBox CStr(nFilesCnt + 1) & " Dateien wurden gefunden!", _
vbInformation, "VB-fun-Demo"
Else
MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
vbCrLf & strPath & vbCrLf & "gefunden!", _
vbInformation, "VB-fun-Demo"
End If
Else
MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
"existiert nicht!", vbInformation, "VB-fun-Demo"
End If
End Sub
|
|
|
|
|
|
|
| Windows-Version |
| 95 |
 |
|
| 98 |
|
|
| ME |
|
|
| NT |
|
|
| 2000 |
|
|
| XP |
|
|
| Vista |
|
|
| Win
7 |
|
|
|
| Excel-Version |
| 95 |
|
|
| 97 |
|
|
| 2000 |
|
|
| 2002
(XP) |
|
|
| 2003 |
|
|
| 2007 |
|
|
| 2010 |
|
|
|
|
Download (18,1 kB)
|
Downloads bisher: [ 812 ]
|
|
|
Vorheriger Tipp
Zum Seitenanfang 