Split-Funktion in VBA

Hallo,
habe vermutlich ein einfach zu lösendes Problem. Ich habe eine Text-Datei die zu Excel importiert wird (per VBA, mit einem Button). In dieser Datei befinden sich Tausende Werte die nebeneinander geschrieben sind, diese werden in Excel untereinander aufgelistet. Das alles funktionierte bisher auch sehr gut aber letztens habe ich bei einer Datei festgestellt, dass das Tool einen Fehler ausgab. Nach langer Sucherei fand ich den Fehler.
Das Trennzeichen, mit dem ich die nebenstehenden Werte trenne und in Excel untereinander aufliste, ist ein Leerzeichen Komma Leerzeichen ( , ). Einer dieser Werte hat genau diese Folge in seiner Beschreibung stehen, daher der Fehler. Jetzt wollte ich den Teil im Code so umbauen das es passt. Die Werte haben folgenden Aufbau: 12345: Beispielwert , 4567: Beispielwert 1 .....
Was jetzt als Trennung passt wäre: " , Zahl:"
Der Teil im Code ist der hier:
vntArrayWerte = Split(strText, " , ")
Wie kann ich den Bereich so umändern, das es passt?
Gruß
kesici

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Do While deinText Like "* , #*" 'für primär pos=0 pos = Instr(pos + 1, deinText, " , ") If CBool(pos) Then If IsNumeric(Mid(deinText, pos + 4, 1)) Then _ deinText = Left(deinText, pos - 1) & Chr(0) & _ Mid(deinText, pos + 4) Else: Exit Do End If Loop splitText = Split(deinText, Chr(0))

If .Show Then intFileNumber = FreeFile Open .SelectedItems(1) For Binary As #intFileNumber strText = Space(LOF(intFileNumber)) Get #intFileNumber, 1, strText Close #intFileNumber vntArrayWerte = Split(strText, " , ") ' zuerst Komma, dann Leerzeichen lngPos = InStr(vntArrayWerte(0), "Werte:") If lngPos 0 Then strAnfang = Mid(vntArrayWerte(0), 1, lngPos + 6) vntArrayWerte(0) = Mid(vntArrayWerte(0), lngPos + 6) ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Value = strAnfang End If strText = vntArrayWerte(UBound(vntArrayWerte)) ReDim Preserve vntArrayWerte(UBound(vntArrayWerte) - 1) ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Resize( _ UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte) lngPos = UBound(vntArrayWerte) + 2 Erase vntArrayWerte vntArrayWerte = Split(strText, vbCrLf) For lngFN = 0 To UBound(vntArrayWerte) If Mid(vntArrayWerte(lngFN), 1, 1) "=" Then ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = _ vntArrayWerte(lngFN) Else ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = "'" & _ vntArrayWerte(lngFN) End If Next End If

…Emre,
mal ein Bsp dafür geschrieben, wie ich mir das vorstelle. Die irrelevanten Teile msst du dann natürlich durch deine Organisation ersetzen:

Sub TrennTest()
Const txIntro$ = "Werte:", txHTrenn$ = " , ", txVTrenn$ = vbCrLf
Dim lngPos As Long, strAnfang$, strText$, vntArrayWerte
strText = ActiveWindow.RangeSelection
Do While strText Like "*" & txHTrenn & "#*"      'primär lngPos=0
lngPos = InStr(lngPos + 1, strText, txHTrenn)
If CBool(lngPos) Then
If IsNumeric(Mid(strText, lngPos + 4, 1)) Then _
strText = Left(strText, lngPos - 1) & Chr(0) & _
Mid(strText, lngPos + 3)
Else: Exit Do
End If
Loop
vntArrayWerte = Split(strText, Chr(0))
lngPos = InStr(vntArrayWerte(0), txIntro)
If CBool(lngPos) Then
strAnfang = Mid(vntArrayWerte(0), 1, lngPos - 1 + Len(txIntro))
vntArrayWerte(0) = LTrim(Mid(vntArrayWerte(0), lngPos + Len(txIntro)))
End If
strText = vntArrayWerte(UBound(vntArrayWerte))
ReDim Preserve vntArrayWerte(UBound(vntArrayWerte) - 1)
For lngPos = 0 To UBound(vntArrayWerte)         'nur als Test
vntArrayWerte(lngPos) = _
Replace(vntArrayWerte(lngPos), txHTrenn, LTrim(txHTrenn))
If MsgBox(vntArrayWerte(lngPos), vbInformation + vbOKCancel, _
strAnfang & " horText " & lngPos + 1) = vbCancel Then Exit For
Next lngPos
vntArrayWerte = Empty: vntArrayWerte = Split(strText, txVTrenn)
For lngPos = 0 To UBound(vntArrayWerte)         'nur als Test
vntArrayWerte(lngPos) = _
Replace(vntArrayWerte(lngPos), txHTrenn, LTrim(txHTrenn))
If MsgBox(vntArrayWerte(lngPos), vbInformation + vbOKCancel, _
strAnfang & " verText " & lngPos + 1) = vbCancel Then Exit For
Next lngPos
End Sub

Mit folgd TestText hat das wie erwartet fktioniert:
Alfa-Werte: 12345: BspWert0 , 4567: BspWert1 , 25999: BspWert2 , 1188: Bsp , Wert3 , 33123: BspWert4 , 1234: BspWert5 , 56789: BspWert6 , 999: BspWert7 , 8888: Bsp , Wert8 , 77777: BspWert9 , 9901: BspWert10
9902: BspWert11
9903: BspWert12
9904: BspWert13
9905: BspWert14
Morrn, Luc :-?

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

36 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Split-Funktion in VBA

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

36 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread