eliminar el 0 inicial delante del decimal excepto cuando un número distinto de cero lo precede

Tengo una columna, que tiene valores separados por comas dentro de cada celda que se ve así

0.1, 0.2,0.3, 0.4,0.5, 0.8,1.0
1.5, 1.6,2.0, 10.6,10.9, 15.2,30.75
20, 0.25,280.2, 0.29,300.2, 423,530.76

Como una cadena de texto.

El objetivo es eliminar el cero inicial delante del decimal, pero solo cuando no hay otro dígito (incluido otro 0) delante, utilizo la función de búsqueda de reemplazo vba:

    Opción explícita
    Public Sub Replace0dot (Opcional byDummy como Byte)
        Columnas ("A"). Reemplazar qué: "0.", _
                            Reemplazo: = ".", _
                            LookAt: = xlPart, _
                            SearchOrder: = xlByRows, _
                            MatchCase: = False, _
                            SearchFormat: = False, _
                            Reemplazar formato: = falso
    Application.ScreenUpdating = True
    End Sub 

y termino con esto:

.1, .2,.3, .4,.5, .8,1
1.5, 1.6,2, 1.6,1.9, 15.2,3.75
2, .25,28.2, .29,30.2, 423,53.76

Elimina todas las instancias de liderazgo 0.con ., por lo que ves se 10.6convierte 1.6. Pero debería permanecer. 10.6 ¿Cómo puedo obtener una búsqueda que reemplace el equivalente que me da:

.1, .2,.3, .4,.5, .8,1
1.5, 1.6,2, 10.6,10.9, 15.2,30.75
20, .25,280.2, .29,300.2, 423,530.76

??? Parece que tendría que ser sin concatenar y volver a concatenar para lograr el objetivo.

Aquí hay un enfoque muy simple:

• si la cadena comienza con 0. luego suelte el cero
• si la cadena contiene tripletes como {space} 0. entonces deja caer ese cero
• si la cadena contiene tripletes como , 0. entonces deja caer ese cero

Seleccione las celdas y ejecute este código:

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

antes de:

y después:

Si hay otros tripletes que deben cambiarse, simplemente agregue otro Replace()

EDITAR # 1:

Para evitar la selección manual de las celdas, podemos hacer que la macro lo haga ......... aquí hay un ejemplo para la columna 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

EDITAR # 2

En esta versión agregamos a ; al final de cada celda justo antes de ingresar texto en esa celda:

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

EDITAR3 #:

En esta versión el ; se agrega solo si aún no está presente en la celda:

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

EDITAR # 4:

Esta versión no afectará a las celdas vacías:

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

EDITAR # 5:

Esto corrige el error en la versión anterior:

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

Use este código VBA, probará cada cadena para ceros a la izquierda

Sub Reemplazar0dot ()

   Dim str As String    
   Dim ln As Long   
   Dim i As Long    

   ln = Range("A1").End(xlDown).Row   
   For i = 1 To ln
   str = Cells(i, 1).Value
   If Left(str, 1) = "0" Then
   Cells(i, 1) = Mid(str, 2)
   End If
   Next i

End Sub   

Suponiendo que todavía está trabajando con líneas de notepad ++ , puede usar una matriz en lugar de texto en columnas

Sub notepadthingrevisit()
    Dim workingRange As Range
    Set workingRange = Range("A1:A3")
    Dim i As Long
    Dim j As Long
    Dim result As String

    Dim myStrings() As String
    For i = 1 To workingRange.Rows.Count
        myStrings = Split(Cells(i, 1), ",")
        'Adjust this for accounting for the first value and remember to trim the " " at the end
        For j = 0 To UBound(myStrings)
            If Left(Trim(myStrings(j)), 1) = 0 Then
                myStrings(j) = Right(Trim(myStrings(j)), (Len(Trim(myStrings(j))) - 1))
            End If
            If myStrings(j) = Int(myStrings(j)) Then myStrings(j) = Int(myStrings(j))
            'Check here for j mod x and insert " "
            result = result & myStrings(j) & ","
        Next
        Cells(i, 5) = result
    Next

End Sub

Simplemente use la información del hilo anterior para insertar sus espacios.