Sub 千分位()
Dim myRange As Range, i As Byte, myValue As Currency
On Error Resume Next
Application.ScreenUpdating = False
NextFind: Set myRange = ActiveDocument.Content
With myRange.Find
.ClearFormatting
.Text = "[0-9]{4,15}"
.MatchWildcards = True
Do While .Execute
i = 2
If myRange.Next(wdCharacter, 1) = "." Then
While myRange.Next(wdCharacter, i) Like "#"
i = i + 1
Wend
myRange.SetRange myRange.Start, myRange.End + i - 1
End If
myValue = VBA.Val(myRange)
myRange = VBA.Format(myValue, "Standard")
GoTo NextFind
Loop
End With
Application.ScreenUpdating = True
End Sub