[已解决]求助：可以问word的问题吗？想一次性把word里的数字全部改成会计格式

小审计

一次性把word里的数字全部改成会计格式，很多数字，财务需要，要从普通的，改成有千分号且后代两位小数点的格式样子，请高手教我一下。

最佳答案

月排行榜 / 总排行榜

庭院幽幽

2012-3-6 11:25

word自身没有这个功能，可以使用编写VBA代码实现，效果如下

整篇文档批量一次性添加。
代码如下：
Sub qianfen()
'本代码旨在解决WORD中数据转化为千分位
'数据限定要求:-922,337,203,685,477.5808 到 922,337,203,685,477.5807
'转化结果1000以上数据以千分位计算,小数点右侧保留二位小数;1000以下数据不变
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}" '4到15位数据
.MatchWildcards = True '使用通配符
Do While .Execute '每次查找成功
i = 2 '起始值为2
'如果是有小数点
If myRange.Next(wdCharacter, 1) = "." Then
'进行一个未知循环
While myRange.Next(wdCharacter, i) Like "#"
i = i + 1 '只要是[0-9]任意数字则累加
Wend
'重新定义RANGE对象
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

按ALT+F11，打开VBE复制上面的代码，然后运行宏，就可以批量添加。

跳转到最佳答案楼层

平原

复制到EXCEL中，设置成你需要的格式，再粘贴到WORD中。

tony3

上附件，会有人帮你的。

小审计

就是把word2007的所有数字格式改成会计格式就行了，不用传附件吧。word里那么多内容不光是数字，估计不能用复制到execel然后贴回来的方式，除了这个办法，没别的方式吗？

小审计

平原 发表于 2012-3-6 11:10
复制到EXCEL中，设置成你需要的格式，再粘贴到WORD中。

复制粘贴后整个文档格式全部破坏，调格式更麻烦的。

小审计

tony3 发表于 2012-3-6 11:11
上附件，会有人帮你的。

就是把word2007里的文档中所有数字的格式改成会计格式就行了，要求应该表述的很清楚了。附件是公司文件，上传比较难搞

平原

那就要具体问题具体对待，请上传附件（简单的举个例子就行了）。

庭院幽幽

word自身没有这个功能，可以使用编写VBA代码实现，效果如下

整篇文档批量一次性添加。
代码如下：
Sub qianfen()
'本代码旨在解决WORD中数据转化为千分位
'数据限定要求:-922,337,203,685,477.5808 到 922,337,203,685,477.5807
'转化结果1000以上数据以千分位计算,小数点右侧保留二位小数;1000以下数据不变
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}" '4到15位数据
.MatchWildcards = True '使用通配符
Do While .Execute '每次查找成功
i = 2 '起始值为2
'如果是有小数点
If myRange.Next(wdCharacter, 1) = "." Then
'进行一个未知循环
While myRange.Next(wdCharacter, i) Like "#"
i = i + 1 '只要是[0-9]任意数字则累加
Wend
'重新定义RANGE对象
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

按ALT+F11，打开VBE复制上面的代码，然后运行宏，就可以批量添加。