在VBA中使用RegExp删除尾随零

时间:2019-02-21 12:33:14

标签: regex vba ms-word

.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

1 个答案:

答案 0 :(得分: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