Alles vor Zeichen entfernen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub zahlen() Dim rng As Range, Pre As String Pre = "0145." For Each rng In Range("D:D").SpecialCells(xlCellTypeConstants).Cells If IsNumeric(rng) Then If Left(rng, 5) <> Pre Then rng = Pre & Val(rng.Text) End If End If Next End Sub

Hi UweD
Ich hab mal einige Beispiele zusammengefasst wie das aussehen könnte.
Vor alle diese Zahlen soll am Ende die "0145." stehen - nur einmal.
Es soll keine Sonderzeichen enthalten, nur den einen Punkt in der ganzen Zahl.
(Die "0145." ist letztendlich nur eine Variable die durch ein Textfeld bestimmt wird, weil es dann darauf ankommt was als Führungsnummer gebraucht wird, aber das ist nur eine Formalität.)
Wohlgemerkt:
Es ist kein Fall der aktuell so ist.
Es ist tatsächlich nach Sepp´s Lösung im Moment alles so wie es zu sein hat.
Aber ich fürchte, dass es in naher oder hoffentlich ferner Zukunft dazu kommen wird - weil es m.E.n. IMMER zu einem Zahlengewurstel kommt wenn Nutzern erlaubt wird quasi alles einzutragen weil es kein einheitliches Eintragesystem gibt...
Ich will nur nicht grundsätzlich alle paar Wochen einige tausend Zeilen in 50 Tabellen per Hand durchsuchen müssen um eine "0145.145." oder eine "0145.145.145.145." etc zu finden - die vielleicht gar nicht da ist...da werde ich schon beim bloßen Gedanken daran verrückt *rofl*
Also auf jeden Fall danke ich dir für deine Hilfe :-)
MfG
Daniel
https://www.herber.de/bbs/user/112990.xlsx

Sub Zahlen() Dim Rng As Range, Sp As Integer, Pre As String Pre = "0145." Sp = 1 'Spalte A For Each Rng In Columns(Sp).SpecialCells(xlCellTypeConstants).Cells If IsNumeric(Rng) Then If Left(Rng, 5) = Pre Then 'nichts ElseIf Left(Rng, 4) = Mid(Pre, 2) Then Rng = "0" & Rng ElseIf Left(Rng, 4) = Left(Pre, 4) Then Rng = Pre & Mid(Rng, 5) ElseIf Left(Rng, 5) = "0154." _ Or Left(Rng, 5) = "0514." Then ' Weitere? 'das sind aber dann Schreibfehler, die nicht so einfach 'über die Variable abzudecken sind Rng = Pre & Mid(Rng, 6) Else Rng = Pre & Val(Rng.Text) End If End If Next End Sub

Option Explicit Sub WechselnK() Dim myArea As Range, out, i& Dim regex: Set regex = CreateObject("vbscript.regexp") Const REPLACE_STRING = "145." ' ggf anpassen Const INCOLUMN = 1 ' ggf anpassen-Spalte die geprüft werden soll regex.Pattern = "^([^\d\w]?[0145]*\.?)(.*?$)" With ThisWorkbook.Sheets("Tabelle1") ' ggf Tabellenblattname anpassen Set myArea = .Cells(1, INCOLUMN).Resize(.Cells(.Rows.Count, INCOLUMN).End(xlUp).Row) out = myArea.Value For i = 1 To UBound(out, 1) out(i, 1) = regex.Replace(out(i, 1), REPLACE_STRING & "$2") Next myArea = out End With End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Alles vor Zeichen entfernen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread