Frage an Rudi Maintaire
29.05.2008 15:42:00
christian
du hattest mir exzellente Hilfe bei meinem Datentransformationsproblem gegeben.
Dafür nochmals Danke.
Ich habe nur noch eine kleine Frage:
Kann er diese Excel-Tabellen auch auf Basis eines Musterblattes erstellen? (In welchen dann die Werte in schon vorgefertigte Garfiken übernommen werden)
Du hattest mir folgenden Code geliefert:
Sub TXT2XLS()
'Alle .txt (Trennzeichen Leerzeichen) eines Ordners in .xls umwandeln
Dim oFS As Object, oFolder As Object, oFile As Object
Dim strFolder As String
Const strDelimiter As String = " " 'Leerzeichen
Dim strTxt As String, myArr, lngL As Long, WKS As Worksheet, iFREE As Integer
With Application.FileDialog(4)
.InitialFileName = "c:\"
.InitialView = 2
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
On Error GoTo FEHLER
DoEvents
Application.ScreenUpdating = False
Set oFS = CreateObject("scripting.filesystemobject")
Set oFolder = oFS.getfolder(strFolder)
iFREE = FreeFile
For Each oFile In oFolder.Files
If oFile.Name Like "*.txt" Then
lngL = 1
Open oFile For Input As iFREE
Set WKS = Workbooks.Add(1).Sheets(1)
Do Until EOF(iFREE)
Line Input #iFREE, strTxt
myArr = Split(strTxt, strDelimiter)
With WKS
.Range(.Cells(lngL, 1), .Cells(lngL, UBound(myArr) + 1)) = myArr
End With
lngL = lngL + 1
Erase myArr
Loop
Close #iFREE
With WKS.Parent
.SaveAs Replace(oFile, ".txt", ".xls"), xlWorkbookNormal
.Close False
End With
Set WKS = Nothing
End If
Next oFile
AUFRAEUMEN:
Set oFile = Nothing
Set oFolder = Nothing
Set oFS = Nothing
Application.ScreenUpdating = True
Exit Sub
FEHLER:
If Err.Number Then
MsgBox "Fehler!" & vbLf & Err.Description
Err.Clear
Resume AUFRAEUMEN
End If
End Sub
Was müsste ich verändern? (Sofern dies möglich ist)
christian