Auswertung Fragebogen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo André!
Probier mal und lass mich wissen, ob das Ergebnis deinen Vorstellungen entspricht.
Option Explicit

Sub Daten_Einlesen_Spezial()
'Daten aus Textdatei mit folgendem Aufbau Zeilenweise einlesen
'und auf Spalten und Zeilen aufteilen
'
'Aufbau der Textdatei:
'############################
'--- Nr 1 ---
'[15]
'Antowort Frage 15
'--- Nr 2 ---
'[2]
'Berlin
'[3]
'Zusammenlebend
'[5]
'evangelisch
'[6]
'Antowort Frage 6
'[13]
'############################
Dim strText As String, strFile As String, str As String
Dim lngLine As Long, lngC As Long, lRow As Long
Dim iCol As Integer
Dim wks As Worksheet
lRow = 1
Set wks = Sheets("Tabelle3") 'Tabelle in die geschrieben wird - anpassen
strFile = Application.GetOpenFilename("Textdateien (*.txt; *.log; *.dat),")
Close #1
'Öffnen und die Anzahl der zeilen fesstellen
Open strFile For Input As #1
lngLine = 0
Do While Not EOF(1)
Input #1, strText
lngLine = lngLine + 1
Loop
Close #1 'Schliessen
'Öffnen und Daten schreiben
Open strFile For Input As #1
For lngC = 1 To lngLine
Input #1, strText
If InStr(1, strText, "---") > 0 Then
lRow = lRow + 1
wks.Cells(lRow, 1) = Replace(strText, "---", "")
ElseIf InStr(1, strText, "[") > 0 Then
iCol = CInt(Replace(Replace(strText, "[", ""), "]", "")) + 1
Else
wks.Cells(lRow, iCol) = strText
End If
Next lngC
Close #1
End Sub

Gruß Sepp

Hallo Walter!
Das ich konnte nicht wissen, das mehrzeilige Antworten vorkommen, ist aber kein Problem!
Ich hab den Code noch etwas verfeinert.
Probier und lass mich wissen ob's funktioniert!
Option Explicit

Sub Daten_Einlesen_Spezial()
'Daten aus Textdatei mit folgendem Aufbau Zeilenweise einlesen
'und auf Spalten und Zeilen aufteilen
'
'Aufbau der Textdatei:
'############################
'--- Nr 1 ---
'[15]
'Antowort Frage 15
'--- Nr 2 ---
'[2]
'Berlin
'[3]
'Zusammenlebend
'[5]
'evangelisch
'[6]
'Antowort Frage 6
'[13]
'############################
Dim strText As String, strFile As String, str As String
Dim lngLine As Long, lngC As Long, lRow As Long, lngCalc As Long
Dim iCol As Integer
Dim wks As Worksheet
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo FEHLER
lRow = 1
Set wks = Sheets("Tabelle3") 'Tabelle in die geschrieben wird - anpassen
strFile = Application.GetOpenFilename("Textdateien (*.txt; *.log; *.dat; *.fre),*.txt; *.log; *.dat; *.fre")
'alternativ "strFile = Application.GetOpenFilename()" wenn es sonst nicht funktioniert!
If strFile = "Falsch" Then Exit Sub
Close #1
'Öffnen und die Anzahl der zeilen fesstellen
Open strFile For Input As #1
lngLine = 0
Do While Not EOF(1)
Input #1, strText
lngLine = lngLine + 1
Loop
Close #1 'Schliessen
'Öffnen und Daten schreiben
Open strFile For Input As #1
For lngC = 1 To lngLine
Input #1, strText
If InStr(1, strText, "---") > 0 Then
lRow = lRow + 1
wks.Cells(lRow, 1) = Trim$(Replace(strText, "---", ""))
ElseIf InStr(1, strText, "[") > 0 Then
iCol = CInt(Trim$(Replace(Replace(strText, "[", ""), "]", ""))) + 1
Else
wks.Cells(lRow, iCol) = wks.Cells(lRow, iCol) & " " & Trim$(strText) & " "
wks.Cells(lRow, iCol) = Trim$(wks.Cells(lRow, iCol))
End If
Next lngC
Close #1
wks.Columns.AutoFit
FEHLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
End With
End Sub

Code eingefügt mit: Excel Code Jeanie
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread