Teile aus Rufnummern löschen

Hallo Leute,
ich habe eine lange Liste mit verschiedenen Telefonnummern in Spalte B, die ich gerne vereinheitlichen möchte.
Zumeist sind die vorhandenen Nummern in den beiden folgenden Quellformaten.
Ich möchte einerseits die beiden Nullen AM ANFANG einiger Rufnummern entfernen
Quellwert: 004951134005678
Ziel: 4951134005678
und andererseits soll in diesem Fall nur die Null nach den ersten beiden Zahlen entfernt werden:
Quellwert: 410572334005678
Ziel: 41572334005678
Die neuen Werte sollen die Werte in der Ursprungsspalte ersetzen und nicht in eine neue Zeile geschrieben werden.
Die Liste ist fix und es kommen keine neuen Werte fortlaufend hinzu.
Bei mir löschen sich irgendwie immer gleich ALLE Nullen in der Ziffernfolge :(
Bislang habe ich mit REPLACE gearbeitet...
Leider habe ich noch nicht genug VBA-Kenntnisse, um die Nummern vernünftig mit anderen VBA-Funktionen (suchen, teil, links, rechts, split, etc...) nach den Nullen zu durchforsten und das richtige Format auszugeben.
Wer kann mir helfen?
Viele Grüße,
Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Nullen_weg() Dim i As Long For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row If Left(Cells(i, 2), 2) = "00" Then Cells(i, 2) = Mid(Cells(i, 2), 3)'---Eintrag ab 3. Stelle ElseIf Mid(Cells(i, 2), 3, 1) = "0" Then'--wenn 3.Stelle eine "0" Cells(i, 2) = Application.Substitute(Cells(i, 2), "0", "", 1)'--wechseln -- erste Vorkommen der "0" End If Next End Sub

HI
wobei ich hier eher mit Formeln arbeiten würde:


=WENN(LINKS(B1;2)="00";TEIL(B1;3;99);WENN(TEIL(B1;3;1)="0";LINKS(B1;2)&TEIL(B1;4;99);B1))

Formel in einer freien Spalte eintragen, dann kopieren und in Spalte B1 als Wert einfügen:
Das funktioniert von Hand sehr gut und schnell, hat aber auch als VBA-Makro gegenüber der Schleife über die Zellen ein paar vorteile:
Es ist in der Regel schneller als die Schleife über die Zellen und vom Code hier kürzer (weil die Hauptarbeit in der Formel steckt)
Weiterer Vorteil: du kannst das Ergebnis in der neuen Spalte von Hand testen und die Formel ggf anpassen, ohne dass dir die Originaldaten verloren gehen.
das erleichtert die Prüfung, ob die Formel bzw das Makro auch richtig arbeitet (dafür dann das kopieren und einfügen noch deaktivieren


With ActiveSheet.Usedrange
with .Columns(.Columns.Count + 1)
.FormulaLocal = "=WENN(LINKS(B1;2)=""00"";TEIL(B1;3;99);WENN(TEIL(B1;3;1)=""0"";LINKS(B1;2)&TEIL(B1;4;99);B1))
.Copy
.Offset(0, 2 - .Column).PasteSpecial xlpastevalues
.ClearContents
end with
end with

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Teile aus Rufnummern löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread