Удалить конечные нули с помощью RegExp в VBA

Question

У меня есть несколько таблиц в моем файле .docx.Среди чисел в этой таблице некоторые десятичные числа встречаются как "43,0" и "2300".Я написал скрипт на VBA для удаления всех конечных нулей:

Sub DeleteTrailingZeros()
Application.ScreenUpdating = False
Dim Tbl As Word.table
For Each Tbl In ActiveDocument.Tables
  With Tbl.Range.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .MatchWildcards = True
   .Text = "(\,\d*?[1-9])0+$"
   .Replacement.Text = "\1"
   .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
 End With
Next Tbl
End Sub

Однако он не работает.В чем может быть проблема?

Отредактировано: Версия на основе регулярных выражений.Картина кажется правильной, но ничего не найдено.Связанная часть выражения, похоже, не заменена правильно, а просто удалена.Не могу понять, почему это происходит.

Sub DeleteTrailZerosRegExp()
    Set Location = ActiveDocument.Range

    Dim j As Long
    Dim regexp As Object
    Dim Foundmatches As Object
    Set regexp = CreateObject("VBScript.RegExp")

    With regexp
        .Pattern = "([\,]\d*?[1-9])0+$"
        .IgnoreCase = True
        .Global = True

        Set Foundmatches = .Execute(Location.Text)
        For j = Foundmatches.Count - 1 To 0 Step -1
            With ActiveDocument.Range.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Replacement.Font.Hidden = True
                .Text = Foundmatches(j)
                .Replacement.Text = regexp.Replace(Foundmatches(j), "$1")
                .Execute Replace:=wdReplaceAll
            End With
        Next j
    End With
End Sub

Answer 1

Вам не нужно регулярное выражение.Попробуйте:

Sub DeleteTrailingZeros()
Application.ScreenUpdating = False
Dim Tbl As Table, Rng As Range, StrVal As String, i As Long
For Each Tbl In ActiveDocument.Tables
  With Tbl
    Set Rng = .Range
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = ",[0-9]@>"
        .Replacement.Text = ""
        .Execute
      End With
      Do While .Find.Found
        If Not .InRange(Rng) Then Exit Do
        StrVal = .Text
        Do While Right(StrVal, 1) = "0"
          StrVal = Left(StrVal, Len(StrVal) - 1)
        Loop
        If StrVal = "," Then StrVal = ""
        .Text = StrVal
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
  End With
Next Tbl
Application.ScreenUpdating = True
End Sub

или, несколько проще:

Sub DeleteTrailingZeros()
Application.ScreenUpdating = False
Dim StrVal As String, i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = ",[0-9]@>"
    .Replacement.Text = ""
    .Execute
  End With
  Do While .Find.Found
    If .Information(wdWithInTable) = True Then
      StrVal = .Text
      Do While Right(StrVal, 1) = "0"
        StrVal = Left(StrVal, Len(StrVal) - 1)
      Loop
      If StrVal = "," Then StrVal = ""
      .Text = StrVal
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub