在 VBA 中使用 RegExp 删除尾随零答案

【问题标题】：Delete trailing zeros with RegExp in VBA在 VBA 中使用 RegExp 删除尾随零
【发布时间】：2019-07-15 08:57:16
【问题描述】：

我的 .docx 文件中有几个表格。在这些表中的数字中，一些十进制数字出现，如“43,0”和“2,300”。我在 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

【问题讨论】：

Range.Find 不支持正则表达式，只支持通配符。
谢谢。我的搜索导致为 .Text 选项写入模式“([\,][1-9]{0,})0@”。它因格式错误而失败。
是的，我现在无法检查，但 {0,} 不起作用，通配符不支持 零或多个 概念。它们只是无法匹配可选模式，这就是它们不是正则表达式的原因。
您能告诉我如何使用正则表达式重写上面的代码吗？
见this SO post。

标签： regex vba ms-word

【解决方案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

【讨论】：

只应删除逗号后的零。当只有零时，逗号也应该删除。
@ArtemZefirov 代码已修改。