Here is a very simple approach:
- if the string begins with 0. then drop the zero
- if the string contains triplets like {space}0. then drop that zero
- if the string contains triplets like ,0. then drop that zero
Select the cells and run this code:
Sub fixdata()
Dim r As Range, t As String
For Each r In Selection
t = r.Text
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
r.Value = t
Next r
End Sub
before:
and after:
If there are other triplets that must be changed, just add another Replace()
EDIT#1:
To avoid manual selection of the cells, we can have the macro do it.........here is an example for column A:
Sub fixdata2()
Dim r As Range, t As String
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
t = r.Text
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
r.Value = t
Next r
End Sub
EDIT#2
In this version we append a ; to the end of each cell just before entering text into that cell:
Sub fixdata3()
Dim r As Range, t As String, Suffix As String
Suffix = ";"
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
t = r.Text
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
r.Value = t & Suffix
Next r
End Sub
EDIT3#:
In this version the ; is appended only if it not already present in the cell:
Sub fixdata4()
Dim r As Range, t As String, Suffix As String
Suffix = ";"
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
t = r.Text
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
If Right(t, 1) <> Suffix Then
r.Value = t & Suffix
End If
Next r
End Sub
EDIT#4:
This version will not affect empty cells:
Sub fixdata5()
Dim r As Range, t As String, Suffix As String
Suffix = ";"
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
t = r.Text
If t <> "" Then
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
If Right(t, 1) <> Suffix Then
r.Value = t & Suffix
End If
End If
Next r
End Sub
EDIT#5:
This fixes the bug in the previous version:
Sub fixdata6()
Dim r As Range, t As String, Suffix As String
Suffix = ";"
For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
t = r.Text
If t <> "" Then
If Left(t, 2) = "0." Then t = Mid(t, 2)
t = Replace(t, " 0.", " .")
t = Replace(t, ",0.", ",.")
If Right(t, 1) <> Suffix Then
t = t & Suffix
End If
r.Value = t
End If
Next r
End Sub
Split
you can also use regular expressions to look for([^0-9])0\.
an replace to$1.
. You can find plenty of tutorials on the net on using regular expressions in VBA.split
orregular expressions
these may work. Did either of you intend to write a answer? I would assume there would have to be some if/then to distinguish between0.
and([^0-9])0\.
. I'm not a programmer, although I try to be logical when writing most of the time.