String verändern

Hallo Zusammen,
folgende Frage. Wie kann ich es per VBA bewerkstelligen, dass in einem String der in etwa so aussieht:
";AUFTRAG-NR. 85911BETR. 173,770;AUFTRAG-NR. 85790BETR. 203,93;AUFTRAG-NR. 86157;PLZ55120BETR. 48,37;AUFTRAG-NR. 86163;PLZ88690BETR. 80,85"
am Ende so aussieht:
";AUFTRAG-NR. 85911;BETR. 173,770;AUFTRAG-NR. 85790;BETR. 203,93;AUFTRAG-NR. 86157;PLZ55120BETR. 48,37;AUFTRAG-NR. 86163;PLZ88690BETR. 80,85"
Abfragekriterien:
Prüfe, wenn mindestens 10 Stellen (incl. Leerzeichen) vor der Zeichenfolge "BETR" keine Zeichenfolge "PLZ" kommt, soll vor der Zeichenfolge "BETR" ein Semikolon gesetzt werden.
Problem ist, dass nicht alle auszuwertenden Zeilen gleich aufgebaut sind..., habe zwar schon viele Eventualitäten abgefangen, aber hierbei komme ich leider nicht mehr weiter und in der Recherche werde ich nicht wirklich fündig...
Für Hilfe besten Dank
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Annett,
vielen Dank für den Tip..., habe es lösen können...
Für die Nachwelt folgender Codeausschnitt. Schönes WE noch...


Sub teil_aus_import_aufbereiten()
introw = 7
aufträgekopieren:
While ActiveSheet.Cells(introw, 1).Value <> ""
If Right(ActiveSheet.Cells(introw, 9), 13) = "NN-GUTSCHRIFT" Then
Kette = ""
For anzahlzellen = 11 To 22
Kette = Kette & ActiveSheet.Cells(introw, anzahlzellen)
Next
If InStr(1, Kette, "BETR") >= 1 Then
For intcounter = 1 To Len(Kette)
PosBETR = InStr(intcounter, Kette, "BETR")
betragsuchen = Mid(Kette, PosBETR - 10, 10)
If InStr(1, betragsuchen, "PLZ") = 0 Then
Kette = Mid(Kette, 1, PosBETR - 1) & "PLZ" & Mid(Kette, PosBETR, Len(Kette))
End If
intcounter = PosBETR + 7
Next intcounter
End If
With WorksheetFunction
Kette = .Substitute(Kette, "AUFTRAG NR.", "AUFTRAG-NR.")
Kette = .Substitute(.Substitute(Kette, "AUFTRAG-NR.", ";AUFTRAG-NR."), "PLZ", ";PLZ")
Kette = .Substitute(Kette, " ", "")
Kette = .Substitute(Kette, "BETR.", "BETR. ")
Kette = .Substitute(Kette, "NR.", "NR.  ")
Kette = .Substitute(Kette, "0Auftrag", ";Auftrag")
If Left(Kette, 2) = "0;" Then Kette = .Substitute(Kette, "0;", ";")
End With
ActiveSheet.Cells(introw, 11).Value = Kette
ActiveSheet.Cells(introw, 11).Value = Right(ActiveSheet.Cells(introw, 11).Text, Len(ActiveSheet.Cells(introw, 11).Text) - 1)
Application.DisplayAlerts = False
ActiveSheet.Cells(introw, 11).Select
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = True
End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread