Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
804to808
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
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Noch eine Frage zu VBA Zeichenkette bearbeiten

Noch eine Frage zu VBA Zeichenkette bearbeiten
21.09.2006 09:06:04
Fred
Guten Tag Excelfreunde,
Hatte gestern diesen Beitrag eingestellt.
VBA Lösung Zeichenkette bearbeiten. - Fred 20.09.2006 11:29:12
Bin, dank der Hilfe fast perfekt. Aber man möchte es ja ganz perfekt.
Also in Zeichenkette zuerst nach den ersten 23 Zeichen ein Semikolon dann nach 6 Zeichen eins und
dann wie gehabt.
11111111111111111111111;555555;0.0.0.0;0.0.0.(A);0.0.(B).0;0.(C).0.0;
Hier noch mal das gute Stück von Coach und UweD

Sub Transform()
Dim r As Range
Dim i As Long, Neu As String, LR%
LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A
For Each r In Range("A10:A1999")
If r.Row > LR Then Exit Sub
Neu = vbNullString
If Not (IsEmpty(r)) Then
For i = 1 To Len(r.Value)
If IsNumeric(Mid(r.Value, i, 1)) Then Neu = Neu & Mid(r.Value, i, 1) Else Neu = Neu & "(" & Mid(r.Value, i, 1) & ")"
Neu = Neu & IIf(i Mod 4 = 0, ";", ".")
Next
r.Offset(0, 1).Value = Neu
End If
Next
End Sub

Auf Lösung bin ich gespannt, denn meine Versuche waren alle unter Sau.
MfG
Fred

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Noch eine Frage zu VBA Zeichenkette bearbeiten
21.09.2006 09:23:53
Coach
Hallo Fred,
hier die angepaßte Version:

Sub Transform()
Dim r As Range
Dim i As Long, Neu As String, LR%
LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A
For Each r In Range("A10:A1999")
If r.Row > LR Then Exit Sub
If Not (IsEmpty(r)) Then
Neu = Left(r.Value, 23) & ";" & Mid(r.Value, 24, 6) & ";"
For i = 30 To Len(r.Value)
If IsNumeric(Mid(r.Value, i, 1)) Then Neu = Neu & Mid(r.Value, i, 1) Else Neu = Neu & "(" & Mid(r.Value, i, 1) & ")"
Neu = Neu & IIf((i - 29) Mod 4 = 0, ";", ".")
Next
r.Offset(0, 1).Value = Neu
End If
Next
End Sub

Gruß Coach
Anzeige
Danke! Super
21.09.2006 11:10:54
Fred
Mein Freund Coach,
Nicht nur sehr schnell, sondern perfekt.
MfG
Fred

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige