Anzeige
Archiv - Navigation
984to988
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
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Textdateiimport, sehr kompliziert!

Textdateiimport, sehr kompliziert!
10.06.2008 12:36:50
christian
Hallo,
ich hatte kürzlich ein Problem mit dem Import von Textdatein und ich wand mich hier ans Forum!
Mir wurde freundlich, schnell und professionell geholfen, hier noch einmal Dank an alle Beteiligten.
Jetzt hat sich die Aufgabe etwas vergrößert und ich hoffe auf Eure Hilfe
Zur Aufgabe:
Ich führe Messungen durch und diese sollen ausgewertet werden.
Die Messdaten werden vom Messprogramm als Textdatei ausgegeben. Diese Textdatei besteht aus einem Kopfteil und dem Messdatenteil, dieser beginnt ab Zeile 33. Sie besteht aus drei Spalten die durch Tab getrennt sind, allerdings ist die Zeilenanzahl unterschiedlich, sie schwankt zwischen 2000 und 20000.
Die Kommas werden in der Textdatei als Punkte dargestellt, diese sollen im Arbeitsblatt natürlich als Kommas importiert werden.
Es gibt je Probe 11 Textdatein, die gleichzeitig in ein Arbeitsblatt importiert werden sollen. In dem Ordner befinden sich nur die Textdateien einer Probe. Jede einzelne Textdatei soll in eine andere Tabelle, beginnend mit der zweiten Tabelle, da in der ersten mein Auswertetool ist. Die Namen der Textdatein beginnen immer mit einer Zahl und dann folgt der Probenname. Die Zahlen ändern sich nicht, da diese die Anzahl der (festgelegten) Prüfzyklen zeigen und sollten dann auch der richtigen Tabelle zugeordnet sein. (Die 11 Textdatein beginnen also mit: 5; 10; 20; 50; 100; 200; 500; 1000; 2000; 5000; 10000 und die Tabellennamen sind dann halt die Zahlen)
Nun soll der User einen Button drücken, den Pfad des Ordners der Probe auswählen und alle 11 Textdatein werden importiert. Dabei wäre es günstig, wenn schon der Ordner im Pfadeingabefeld steht, in dem sich alle Probenordner befinden. (da der Ordner auf einem Server gespeichert ist und man ewig klicken muss eh man dort ist)
Manchmal können ein oder zwei Textdatein fehlen, da wurden keine Messungen durchgeführt, da soll die Tabelle einfach leer bleiben.
Ich hoffe ich hab nicht vergessen.
Über Eure Hilfe wäre ich superglücklich, da ich nicht mehr viel Zeit bis zur Diplomabgabe habe und noch eine ganze Menge Proben auswerten muss!
Danke im Voraus
Christian

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textdateiimport, sehr kompliziert!
10.06.2008 12:53:00
Rudi
Hallo,
wäre sehr gut, wenn du mal deinen bisherigen Code zeigen würdest.
Gruß
Rudi

AW: Textdateiimport, sehr kompliziert!
10.06.2008 13:06:45
christian
Hallo Rudi,
wusste ich doch, dass ich was vergessen habe:
Hier der Code:
ist jetzt nur eine Textdatei die in die zweite Tabelle eingefügt wird, auch ist das Umformen von Punkt in Komma noch nicht eingearbeitet

Sub importTextFile()
Dim lngIndex As Long, lngCnt As Long
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant, intC As  _
Integer
strFile = Application.GetOpenFileName("Text Dateien (*.txt),*.txt")
If strFile = "Falsch" Then Exit Sub
Open strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim Preserve varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = varTmp(intC)
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
With Sheets("Datenimport")
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
End Sub


Danke
Christian

Anzeige
AW: Textdateiimport, sehr kompliziert!
10.06.2008 13:28:56
Rudi
Hallo,
ungetestet:

Sub importTextFiles()
Dim lngIndex As Long, lngCnt As Long, intC As Integer
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant
Dim strFolder As String, iFileCounter As Integer, wks As Worksheet
With Application.FileDialog(4)
.AllowMultiSelect = False
.InitialFileName = "c:\test\" 'Startpfad anpassen
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
iFileCounter = 1
strFile = Dir(strFolder & "\*.txt")
Do While strFile  ""
iFileCounter = iFileCounter + 1
Open strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim Preserve varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = varTmp(intC)
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
'Worksheet vorhanden?
On Error Resume Next
Set wks = Worksheets(iFileCounter)
On Error GoTo 0
'Wenn nicht, dann einfügen
If wks Is Nothing Then Worksheets.Add after:=Worksheets(Worksheets.Count)
With Worksheets(iFileCounter)
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
Loop
End Sub


Gruß
Rudi

Anzeige
Korrektur!!
10.06.2008 13:54:00
Rudi
Hallo,
hab noch Fehler gefunden.

Sub importTextFile()
Dim lngIndex As Long, lngCnt As Long, intC As Integer
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant
Dim strFolder As String, iFileCounter As Integer, wks As Worksheet
With Application.FileDialog(4)
.AllowMultiSelect = False
.InitialFileName = "c:\test\" 'Startpfad anpassen
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
strFolder = strFolder & "\"
iFileCounter = 1
strFile = Dir(strFolder & "*.txt")
Do While strFile  ""
iFileCounter = iFileCounter + 1
lngIndex = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = varTmp(intC)
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
'Worksheet vorhanden?
On Error Resume Next
Set wks = Worksheets(iFileCounter)
On Error GoTo 0
'Wenn nicht, dann einfügen
If wks Is Nothing Then Worksheets.Add after:=Worksheets(Worksheets.Count)
With Worksheets(iFileCounter)
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
Loop
End Sub


Gruß
Rudi

Anzeige
AW: Korrektur!!
10.06.2008 14:20:00
christian
Hallo,
das sieht echt schon Super aus! Danke!
Ein paar Kleinigkeiten noch:
- die Punkte müssen als Kommas importiert werden und er schreibt einige Messwerte als Datum auf. Ich hab dann immer die Felder als Zahl mit vier Kommastellen formatiert. Vielleicht geht das auch irgendwie?
- die Namen der Textdateien beginnen mit einer Zahl (die elf oben aufgeführten) und die Tabellen2-12 tragen diese Zahlen als Namen. Sie sollen also zugeordnet werden.
riesig dankend und mit freundlichen Grüßen
Christian

AW: Korrektur!!
10.06.2008 16:01:00
Rudi
Hallo,
hab ich übersehen.

Sub importTextFile()
'erweitert: Rudi Maintaire; 20080610
Dim lngIndex As Long, lngCnt As Long, intC As Integer
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant
Dim strFolder As String, wks As Worksheet
Dim strSheetName As String
With Application.FileDialog(4)
.AllowMultiSelect = False
.InitialFileName = "c:\test\" 'Startpfad anpassen
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
strFolder = strFolder & "\"
strFile = Dir(strFolder & "*.txt")
Do While strFile  ""
strSheetName = Replace(strFile, ".txt", "")
lngIndex = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = Replace(varTmp(intC), ".", ",")
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
'Worksheet vorhanden?
On Error Resume Next
Set wks = Worksheets(strSheetName)
On Error GoTo 0
'Wenn nicht, dann einfügen
If wks Is Nothing Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = strSheetName
With wks
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
Loop
End Sub


Gruß
Rudi

Anzeige
AW: Korrektur!!
10.06.2008 16:56:47
christian
Hallo Rudi,
vielen, vielen Dank! Genauso hatte ich mir das vorgestellt. Perfekt!!
Ein kleines end if hatte wohl noch am Ende gefehlt, deshalb hier nochmal der komplette und einwandfrei funktionierende
Rudi-Excel-Gott-Code:

Sub importTextFile()
'erweitert: Rudi Maintaire; 20080610
Dim lngIndex As Long, lngCnt As Long, intC As Integer
Dim strFile As String, strTmp As String, varValues() As Variant, varTmp As Variant
Dim strFolder As String, wks As Worksheet
Dim strSheetName As String
With Application.FileDialog(4)
.AllowMultiSelect = False
.InitialFileName = "G:\_EG-82(Werkstoffe)\A_METALL\Diplomarbeiten\DA-Heuer\Messergebnisse\"  _
'Startpfad anpassen
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
strFolder = strFolder & "\"
strFile = Dir(strFolder & "*.txt")
Do While strFile  ""
strSheetName = Replace(strFile, ".txt", "")
lngIndex = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
Loop
Close #1
ReDim varValues(1 To lngCnt - 32, 1 To 10)
lngCnt = 0
Open strFolder & strFile For Input As #1
Do While Not EOF(1)
lngCnt = lngCnt + 1
Input #1, strTmp
If lngCnt > 32 Then
If Len(strTmp) > 0 Then
strTmp = Trim$(strTmp)
If Right(strTmp, 1) = Chr(9) Then strTmp = Left(strTmp, Len(strTmp) - 1)
lngIndex = lngIndex + 1
varTmp = Split(strTmp, vbTab)
For intC = 0 To UBound(varTmp)
varValues(lngIndex, intC + 1) = Replace(varTmp(intC), ".", ",")
Next
End If
End If
Loop
Close #1
If lngIndex > 0 Then
'Worksheet vorhanden?
On Error Resume Next
Set wks = Worksheets(strSheetName)
On Error GoTo 0
'Wenn nicht, dann einfügen
If wks Is Nothing Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = strSheetName
With wks
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
End If
Loop
Sheets("Tabelle1").Select
End Sub


Nochmal Danke!
Christian

Anzeige
AW: Korrektur!!
10.06.2008 17:12:30
Rudi
Hallo,
du hast das von mir vergessene End If falsch gesetzt.

If wks Is Nothing Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = strSheetName
End If
With wks
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(UBound(varValues, 1), UBound(varValues, 2))) = varValues
End With
End If
Set wks = Nothing
strFile = Dir
Loop
Sheets("Tabelle1").Select
End Sub


Gruß
Rudi

AW: Korrektur!!
11.06.2008 13:39:28
christian
Hallo,
mir ist gerade noch etwas aufgefallen.
Das Makro erstellt die Tabellen und fügt den Inhalt der Textdatei ein! So soll es sein.
Aber, wenn die Tabellen schon vorhanden sind und man die nächste Probe einlesen will, bleiben die alten Werte drin stehen!
im Voraus dankend und mit freundlichen Grüßen
Christian

Anzeige
AW: Korrektur!!
11.06.2008 16:30:00
Rudi
Hallo,
das kann nicht sein.
Nicht, wenn du das End If an die richtige Stelle geschoben hast.
Gruß
Rudi

AW: Korrektur!!
12.06.2008 10:36:00
christian
Hallo Rudi,
hast natürlich recht, funktioniert einwandfrei! Mein Fehler, 97% aller Fehler sind Bedienerfehler!
Vielen Dank nochmal!
Christian

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige