如何用vba将同一文件夹下多个word文件中的数字批量修改为以万计

hangye

目的：如何用vba将同一文件夹下多个word文件中的数字批量修改为以万计

我搜索了一下论坛 可以实现千分计 不知道我的想法能否实现。谢谢高手帮助！！！

sylun

可试试以下代码，请考虑清楚其适用性，只是针对活动文档，没写遍历部分的代码(该部分代码可在本版搜索到)：
Sub test()
    Dim aNum As String
    Application.ScreenUpdating = False
    With ActiveDocument.Content.Find
        .Text = "[0-9][0-9,.]{4,}"
        .MatchWildcards = True
        Do While .Execute
            With .Parent
                aNum = Replace(.Text, ",", "")
                If IsNumeric(aNum) Then
                    aNum = Round(Val(aNum) / 10000)
                    '如查找到的内容其下一字符不是“万”字则进行替换
                    If Val(aNum) >= 1 And .Next(wdCharacter) <> "万" Then
                        '如数据在表格外，则在数据转换后添加上“万”字
                        .Text = aNum & IIf(.Information(wdWithInTable), "", "万")
                    End If
                End If
                .Collapse wdCollapseEnd
            End With
        Loop
        .Parent.WholeStory
        '以下一句将文档中的“(元)”统一替换为“(万元)”，但此替换可能会导致实际错误，慎用
        .Execute findtext:="\(元\)", replacewith:="(万元)", Replace:=wdReplaceAll
    End With
    Application.ScreenUpdating = True
End Sub

szqhb

万和千不是同一个道理吗？只不过是多一个0和少一个0的问题

hangye

谢谢

hangye

遍历找不到啊

hangye

高手帮忙修改一下 能够选择文件 但只对一篇文件起作用

Sub 批量格式设置()  '此代码为指定文件夹中所有选取的WORD文件的进行格式设置
    Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
    ' On Error Resume Next '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            Application.ScreenUpdating = False
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
   Set Doc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
                With Doc
               
    Dim aNum As String
    Application.ScreenUpdating = False
    With ActiveDocument.Content.Find
        .Text = "[0-9][0-9,.]{4,}"
        .MatchWildcards = True
        Do While .Execute
            With .Parent
                aNum = Replace(.Text, ",", "")
                If IsNumeric(aNum) Then
                    aNum = Round(Val(aNum) / 10000)
                    '如查找到的内容其下一字符不是“万”字则进行替换
                    If Val(aNum) >= 1 And .Next(wdCharacter) <> "万" Then
                        '如数据在表格外，则在数据转换后添加上“万”字
                        .Text = aNum & IIf(.Information(wdWithInTable), "", "万")
                    End If
                End If
                .Collapse wdCollapseEnd
            End With
        Loop
        .Parent.WholeStory
        '以下一句将文档中的“(元)”统一替换为“(万元)”，但此替换可能会导致实际错误，慎用
        .Execute findtext:="\(元\)", replacewith:="(万元)", Replace:=wdReplaceAll
    End With
End With
    Next

            Application.ScreenUpdating = True
        
        End If
    End With
    MsgBox "格式化文档操作设置完毕!", vbInformation
End Sub

sylun

简单修改了一下，请试试：

Sub 批量格式设置()  '此代码为指定文件夹中所有选取的WORD文件的进行格式设置
    Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
    Dim aNum As String
   
    On Error Resume Next '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            Application.ScreenUpdating = False
            
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
                Set Doc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
                With Doc.Content.Find
                    .Text = "[0-9][0-9,.]{4,}"
                    .MatchWildcards = True
                    Do While .Execute
                        With .Parent
                            aNum = Replace(.Text, ",", "")
                            If IsNumeric(aNum) Then
                                aNum = Round(Val(aNum) / 10000)
                                '如查找到的内容其下一字符不是“万”字则进行替换
                                If Val(aNum) >= 1 And .Next(wdCharacter) <> "万" Then
                                    '如数据在表格外，则在数据转换后添加上“万”字
                                    .Text = aNum & IIf(.Information(wdWithInTable), "", "万")
                                End If
                            End If
                            .Collapse wdCollapseEnd
                        End With
                    Loop
                    .Parent.WholeStory
                    '以下一句将文档中的“(元)”统一替换为“(万元)”，但此替换可能会导致实际错误，慎用
                    .Execute findtext:="\(元\)", replacewith:="(万元)", Replace:=wdReplaceAll
                End With
                'Doc.Close True  '保存并关闭文档
            Next
            
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "格式化文档操作设置完毕!", vbInformation
End Sub

tangqingfu

谢谢sylun兄的分享，收藏备用！

hutm

这个看不懂

szqhb

收藏 学习 进步 回馈