AW: 255 Zeichen Begrenzung beim Einlesen
26.10.2006 00:53:58
fcs
Hallo Jürgen,
ich hab nachdem ich mir in Word erst einmal einen Überblick über den Inhalt verschafft hatte, den Import der Daten etwas anders gestaltet. Die einfache Version produziert den von dir dargestellten Aufbau. Damit kann man aber meiner Meinung nach in Excel nur sehr wenig anfangen. Man hat 2 Zellen mit ca. 32 kB Datensalat und eine Zelle mit etwas weniger.
Der zweite etwas aufwendigere Code teilt die Daten in zwei Spalten mit Text auf. So steht, wenn es Koordinaten sind, jetzt in jeder Zeile ein Paar. Für den Alb-Donaukreis werden dabei ca. 2750 Datenzeilen produziert.
Die Integration in dein UF-Makro muss dann noch selber umsetzen.
Gruß
Franz
Public Sub Textdateiimport()
'Koordinaten werden als Pärchen in 2 Spalten ausgegeben.
Dim text, Zeile As Long, I As Long, rechts As Boolean, Spalte As Integer, dateiname, Pos1 As Long
dateiname = "C:\Test\Alb-Donau-Kreis.txt"
Open dateiname For Input As #1
Spalte = 5
Range(Columns(Spalte), Columns(Spalte + 1)).NumberFormatLocal = "@"
rechts = False
Do Until EOF(1)
Line Input #1, text
If Left(text, 1) = "<" Then
Zeile = Zeile + 1
Cells(Zeile, Spalte) = text
Else
Pos1 = 1
For I = 1 To Len(text)
If Mid(text, I, 1) = "," Then
If rechts = False Then
Zeile = Zeile + 1
Cells(Zeile, Spalte) = Mid(text, Pos1, I - Pos1)
rechts = True
Else
Cells(Zeile, Spalte + 1) = Mid(text, Pos1, I - Pos1)
rechts = False
End If
Pos1 = I + 1
Else
If I = Len(text) Then
If rechts = False Then
Zeile = Zeile + 1
Cells(Zeile, Spalte) = Mid(text, Pos1, I - Pos1 - 1)
rechts = True
Else
Cells(Zeile, Spalte + 1) = Mid(text, Pos1, I - Pos1 - 1)
rechts = False
End If
Exit For
End If
End If
Next I
End If
Loop
Close #1
End Sub
Public Sub Textdateiimport2()
'einfache Version, produziert je Zeile in der Text-Datei eine Zeile in Excel
Dim text, dateiname As String, Spalte As Integer, Zeile As Long
dateiname = "C:\Test\Alb-Donau-Kreis.txt"
Open dateiname For Input As #1
Spalte = 8
Columns(Spalte).NumberFormatLocal = "@"
Do Until EOF(1)
Line Input #1, text
Zeile = Zeile + 1
If Right(text, 1) = "," Then
text = Left(text, Len(text) - 1)
End If
Cells(Zeile, Spalte) = text
Loop
Close #1
End Sub