удалить начальный 0 перед десятичным, кроме случаев, когда ему предшествует ненулевое число

Question

У меня есть столбец, который имеет значения, разделенные запятыми внутри каждой ячейки, которые выглядят так

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

Как текстовая строка.

Цель состоит в том, чтобы удалить начальный ноль перед десятичной дробью, но только когда перед ней нет другой цифры (включая еще 0), я использую функцию поиска замены vba:

    Option Explicit
    Public Sub Replace0dot(Optional byDummy As Byte)
        Columns("A").Replace What:"0.", _
                            Replacement:=".", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False
    Application.ScreenUpdating = True
    End Sub 

и я в конечном итоге с этим:

.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

Удаляет все экземпляры ведущих 0. с . Итак, вы видите, 10.6 становится 1.6 . Но это должно остаться 10.6 Как я могу получить эквивалент поиска, который дает мне:

.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

??? Похоже, что для достижения цели нужно было бы не объединять и повторно объединять.

Answer 1

Вот очень простой подход:

• если строка начинается с 0. тогда ноль
• если строка содержит триплеты, такие как {пробел} 0. затем опусти этот ноль
• если строка содержит триплеты, например , 0. затем опусти этот ноль

Выберите ячейки и запустите этот код:

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

до:

и после:

Если есть другие триплеты, которые необходимо изменить, просто добавьте еще одну Replace()

EDIT # 1:

Чтобы избежать ручного выбора ячеек, мы можем сделать это с помощью макроса ......... вот пример для столбца 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

В этой версии мы добавляем ; до конца каждой ячейки непосредственно перед вводом текста в эту ячейку:

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 #:

В этой версии ; добавляется только в том случае, если его еще нет в ячейке:

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:

Эта версия не повлияет на пустые ячейки:

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:

Это исправляет ошибку в предыдущей версии:

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

Answer 2

Используйте этот код VBA, он будет проверять каждую строку на ведущие нули

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   

Answer 3

Предполагая, что вы все еще работаете со строками из notepad++, вы можете использовать массив вместо текста в столбцах

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

Просто используйте информацию из предыдущего потока, чтобы вставить ваши пробелы.