我想对Word中所选内容中嵌入文本中的数字进行四舍五入。与许多在网上取整的解决方案不同，这些值在表格单元格等中不是孤立的，但可能在文本中，并且周围有额外的字符
示例：0.0044***，(0.0040–0.0047(+/-0.012。
我修改了这篇文章中的以下代码，该代码旨在四舍五入到整数：
Sub RoundNumbers()
Dim OrigRng As Range
Dim WorkRng As Range
Dim FindPattern As String
Dim FoundVal As String
Dim decplace as Integer
Set OrigRng = Selection.Range
Set WorkRng = Selection.Range
FindPattern = "([0-9]){1,}.[0-9]{1,}"
decplace = 3
Do
With WorkRng
.SetRange OrigRng.Start, OrigRng.End ' using "set WorkRng = OrigRng" would cause them to point to the same object (OrigRng is also changed when WorkRng is changed)
If .Find.Execute(findtext:=FindPattern, Forward:=True, _
MatchWildcards:=True) Then
.Expand wdWord ' I couldn't find a reliable way for greedy matching with Word regex, so I expand found range to word
.Text = FormatNumber(Round(CDbl(.Text) + 0.000001, decplace), decplace, vbTrue)
End If
End With
Loop While WorkRng.Find.Found
End Sub
我想我可以将Round函数扩展为舍入到指定数量的小数，例如.Text = round(CDbl(.Text) + 0.000001, 3)。
这样做的问题是，宏会继续查找所选内容中的第一个值，而不会移动到后续数字。这可能是因为，与整数不同，四舍五入的值仍然与正则表达式匹配。
建议的解决方案是将一个或多个｛1，｝的小数后位数替换为固定值，例如｛4｝。如果所有要四舍五入的值都有相同的格式，但没有我需要的灵活性，这就可以了。
那么，我怎样才能让它移动到下一个值呢？或者，有人有更好的解决方案吗？
例如，要处理整个文档：
Sub DemoA()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "<[0-9]@.[0-9]@>"
End With
Do While .Find.Execute = True
.Text = Format(.Text, "0.000")
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
或者只处理选定的范围：
Sub DemoB()
Application.ScreenUpdating = False
Dim Rng As Range
With Selection
Set Rng = .Range
.Collapse wdCollapseStart
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "<[0-9]@.[0-9]@>"
End With
Do While .Find.Execute = True
If .InRange(Rng) = False Then Exit Do
.Text = Format(.Text, "0.000")
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
我认为您的问题是没有更改范围以反映要搜索的文本。你似乎每次都在重置到范围的开始。
以下代码可能有助于
Option Explicit
Public Sub RoundNumbers(ByVal ipRange As wordRange)
Dim myRange As Word.Range
If ipRange Is Nothing Then
Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
Else
Set myRange = ipRange.Duplicate
End If
Dim myPreservedRangeEnd As Long
myPreservedRangeEnd = myRange.End
Dim myFindPattern As String
myFindPattern = "[0-9]{1,}.[0-9]{1,}"
Dim myDecplace As Long
myDecplace = 3
Do
Set myRange = FindWildCardPattern(myRange, myFindPattern)
If myRange Is Nothing Then
Exit Do
End If
myRange.Text = FormatNumber(Round(CDbl(myRange.Text) + 0.000001, myDecplace), myDecplace, vbTrue)
' At this point myRange is the newly inserted text so to search
' the remainder of the text in the selection we need to move
' the start to after the current range and replace the end of the
' current range with the preserved end of the selection range
myRange.Start = myRange.End + 1
myRange.End = myPreservedRangeEnd
Loop
End Sub
Public Function FindWildCardPattern(ByVal ipRange As Range, ipFindPattern As String) As Range
If ipRange Is Nothing Then
Set ipRange = ActiveDocument.StoryRanges(wdMainTextStory)
End If
With ipRange
With .Find
.Text = ipFindPattern
.Forward = True
.MatchWildcards = True
.Execute
End With
If .Find.Found Then
Set FindWildCardPattern = .Duplicate
Else
Set FindWildCardPattern = Nothing
End If
End With
End Function
代码中的主要问题是循环位于错误的位置，并且在每个循环中将WordRng设置回开头。在没有任何示例文本的情况下，我用你的问题中的文本来测试。以下内容应该有效：
Sub RoundNumbers()
Dim WorkRng As Range: Set WorkRng = Selection.Range
Dim FindPattern As String: FindPattern = "([0-9]){1,}.[0-9]{1,}"
Dim FoundVal As String
Dim decplace As Integer
decplace = 3
With WorkRng
With .Find
.ClearFormatting
.Text = FindPattern
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Text = FormatNumber(Round(CDbl(.Text) + 0.000001, decplace), decplace, vbTrue)
Loop
End With
End Sub