Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Frage an Rudi Maintaire

Frage an Rudi Maintaire
29.05.2008 15:42:00
christian
hallo Rudi,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage an Rudi Maintaire
29.05.2008 23:10:00
Rudi
Hallo,
evtl anstatt
Set WKS = Workbooks.Add(1).Sheets(1)
Set WKS = Workbooks.Open("c:\Muster.xls").Sheets(1)
Gruß
Rudi
Eine Kuh mach muh, viele Kühe machen Mühe.

AW: Frage an Rudi Maintaire
30.05.2008 09:51:00
christian
Hallo,
er nimmt sich das Muster vor und trägt die Daten ein.
Allerdings überschreibt er die Eintragungen in den ersten beiden Zeilen. Wie kann ich sagen, dass er die letzte beschriebene Zelle ermittelt und die Eintragungen erst danach, also erst in der folgenden Zeile vornimmt?
danke
christian

AUFGABE GELÖST !
30.05.2008 10:54:44
christian
Hallo,
ich habs rausgefunden.
lngL = 1
einfach entsprechend angepasst.
Danke nochmal!
christian
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige