String ab Ziffer abschneiden und verschieben

Hallo
Ich schon wieder. :-(
Ich habe in der Tabelle "Abgang" eine Spalte T, dort sind ab der Zeile 3 folgende Einträge drin:
T_________________U_____________
Buchung 345/345
Buchung AR 453
Buchungen 1-6
Buchungen
Buchung.4
Nur mal um ein paar Kombinationen zu nennen.
Ich suche eine VBA Lösung, mit der ich ALLES ab der ersten Ziffer abschneiden kann und das Ausgeschnittene in die danebenliegenden Spalte U rein schreiben.
Also im Prinzip soll es dann so aussehen:
T_____________U_____________
Buchung_______345/345
Buchung AR____453
Buchungen_____1-6
Buchungen
Buchung.______4
Wenn es keine Ziffer im String gibt, diese Zelle einfach überspringen.
Also, der String vor der Ziffer (von links) kann unterschiedlich sein.
Ab der ersten Ziffer auschneiden und nach U verschieben.
Hat da jemand eine Idee, wie man das lösen könnte ?
Danke Kai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub abschneiden() Dim ende As Long Dim daten Dim zeile As Long Dim stelle As Long Dim inhalt As String ende = Worksheets("Abgang").Cells(Rows.Count, 20).End(xlUp).Row daten = Worksheets("Abgang").Range(Worksheets("Abgang").Cells(1, 20), _ Worksheets("Abgang").Cells(ende, 21)) For zeile = 3 To ende inhalt = daten(zeile, 1) For stelle = 1 To Len(inhalt) If IsNumeric(Mid(inhalt, stelle, 1)) Then daten(zeile, 1) = Left(inhalt, stelle - 1) daten(zeile, 2) = Right(inhalt, Len(inhalt) - stelle + 1) Exit For End If Next stelle Next zeile Worksheets("Abgang").Range(Worksheets("Abgang").Cells(1, 20), _ Worksheets("Abgang").Cells(ende, 21)) = daten End Sub

Hallo! Ich würde einfach vor dem Rückschreiben die Spalte U mit dem Standartformat formatieren.
Worksheets("Abgang").Range("U1:U" & ende).NumberFormat = "General"
Damit müsste es passen. Ansonsten ggf. noch vor dem Schreiben die Daten als String formatieren. So wie unten, da wäre alles drin.
VG Matthias


Sub abschneiden()
Dim ende As Long
Dim daten
Dim zeile As Long
Dim stelle As Long
Dim inhalt As String
ende = Worksheets("Abgang").Cells(Rows.Count, 20).End(xlUp).Row
daten = Worksheets("Abgang").Range(Worksheets("Abgang").Cells(1, 20), _
Worksheets("Abgang").Cells(ende, 21))
For zeile = 3 To ende
inhalt = daten(zeile, 1)
For stelle = 1 To Len(inhalt)
If IsNumeric(Mid(inhalt, stelle, 1)) Then
daten(zeile, 1) = cstr(Left(inhalt, stelle - 1))
daten(zeile, 2) = cstr(Right(inhalt, Len(inhalt) - stelle + 1))
Exit For
End If
Next stelle
Next zeile
Worksheets("Abgang").Range("U1:U" & ende).NumberFormat = "General"
Worksheets("Abgang").Range(Worksheets("Abgang").Cells(1, 20), _
Worksheets("Abgang").Cells(ende, 21)) = daten
End Sub

Sub Reg_SubMatch() 'Verweis MS VbScript Regex 5.5 Dim Str As String Dim RegEx As RegExp Set RegEx = CreateObject("vbscript.regexp") Str = "abc 123s2 qwe edde 456W7" RegEx.Global = True RegEx.Pattern = "\d" Set RR = RegEx.Execute(Str) Debug.Print "Count: " & RR.Count ', RR(0) ', RR(1) For Each R In RR Debug.Print R.FirstIndex, R.Value, R.Length Next R end sub

Beliebteste Forumthreads (12 Monate)

String ab Ziffer abschneiden und verschieben

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread