rimuove lo 0 iniziale davanti al decimale tranne quando un numero diverso da zero lo precede

Ho una colonna, che ha una virgola separata da valori all'interno di ogni cella che assomigliano a questo

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

Come una stringa di testo.

L'obiettivo è quello di rimuovere lo zero iniziale davanti al decimale, ma solo quando non ci sono altre cifre (incluso un altro 0) davanti ad esso uso la funzione di sostituzione di ricerca vba:

    Opzione esplicita
    Public Sub Replace0dot (Facoltativo da Manichino come byte)
        Colonne ("A"). Sostituisci cosa: "0.", _
                            Sostituzione: = ".", _
                            LookAt: = xlPart, _
                            SearchOrder: = xlByRows, _
                            MatchCase: = False, _
                            SearchFormat: = False, _
                            ReplaceFormat: = False
    Application.ScreenUpdating = True
    End Sub 

e finisco con questo:

.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

Rimuove tutte le istanze di lead 0.con ., quindi vedi 10.6diventa 1.6. Ma dovrebbe rimanere 10.6 Come posso ottenere un equivalente sostitutivo della ricerca che mi dà:

.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

??? Sembra che dovrebbe essere non concatenato e ricatenato per raggiungere l'obiettivo.

Ecco un approccio molto semplice:

• se la stringa inizia con 0. quindi rilasciare lo zero
• se la stringa contiene terzine come {space} 0. quindi rilasciare quello zero
• se la stringa contiene terzine come , 0. quindi rilasciare quello zero

Seleziona le celle ed esegui questo codice:

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

prima:

e dopo:

Se ci sono altre terzine che devono essere cambiate, basta aggiungerne un'altra Replace()

EDIT # 1:

Per evitare la selezione manuale delle celle, possiamo fare in modo che la macro lo faccia ......... ecco un esempio per la colonna 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 questa versione aggiungiamo a ; alla fine di ogni cella appena prima di inserire il testo in quella cella:

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 questa versione il ; viene aggiunto solo se non è già presente nella cella:

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:

Questa versione non influirà sulle celle vuote:

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:

Questo risolve il bug nella versione precedente:

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

Usa questo codice VBA per testare ogni stringa per gli zeri iniziali

Sub Replace0dot ()

   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   

Supponendo che tu stia ancora lavorando con le righe di notepad ++ puoi usare un array invece del testo in colonne

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

Usa le informazioni del thread precedente per inserire i tuoi spazi.