Excel替换world中的文字——求助！！！大佬们

地球炒蛋

求助！！！各位大佬，替换，文本很多，每次都是20多个
想在Excel中做好预设，替换我需要多个word文本中的数字

我提前在Excel中设置好文本中的替换数字（ 注意:可以无限写下去有的那种多个）！！
在填写想要的数字
一键替换一个文件夹中数个word的数字（或者生成新的word文本）

3190496160

Sub 批量替换word文档()
Application.ScreenUpdating = False
Dim i%, arr, myPath$, wdApp, wdD
Dim ar As Variant
myPath = ThisWorkbook.Path & "\"
Set sh = ThisWorkbook.Worksheets(1)
With Sheets("Sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
End With
f = Dir(myPath & "*.doc*")
Set wdApp = CreateObject("word.application")
wdApp.Visible = True
Do While f <> ""
    Set wdD = wdApp.Documents.Open(myPath & f)
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "" Then
            With wdApp
                .Selection.HomeKey unit:=6 'wdStory '光标置于文件首
                If .Selection.Find.Execute(ar(i, 1)) Then '查找到指定字符串
                   .Selection.Text = ar(i, 2) '替换字符串
                End If
            End With
        End If
    Next i
    wdD.Save
    wdD.Close True
f = Dir
Loop
wdApp.Quit
Set wdD = Nothing
Set wdApp = Nothing
Application.ScreenUpdating = False
MsgBox "ok!"
End Sub

3190496160

求助-Excel替换world中的文字.rar (37.75 KB, 下载次数: 8)

2024-8-13 09:56 上传

点击文件名下载附件

gwjkkkkk

Option Explicit

Sub TEST()
    Dim ar, i&, k&, wdApp As Word.Application, Items As FileDialogSelectedItems, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    With Application.FileDialog(1)
        With .Filters
            .Clear
            .Add "Word文档(doc*)", "*.doc*"
        End With
        .AllowMultiSelect = True
        .InitialFileName = strPath
        If .Show Then Set Items = .SelectedItems Else Exit Sub
    End With
   
    Application.ScreenUpdating = False
    On Error Resume Next
   
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = New Word.Application
    End If
   
    For k = 1 To Items.Count
        With wdApp.Documents.Open(Items(k))
            For i = 2 To UBound(ar)
                With .Content.Find
                   .ClearFormatting
                   .Text = ar(i, 1)
                   .Replacement.ClearFormatting
                   .Replacement.Text = ar(i, 2)
                   .Execute Replace:=wdReplaceAll
                End With
            Next i
            .Close True
        End With
    Next k
           
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Set Items = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

地球炒蛋

gwjkkkkk 发表于 2024-8-13 21:28
参与一下。。。

大佬这个运行不动，

地球炒蛋

3190496160 发表于 2024-8-13 09:56

大佬这个运行一遍就卡主，这个能不能通篇查找替换，
只替换了一遍

gwjkkkkk

的确有问题，请参考。。。

地球炒蛋

gwjkkkkk 发表于 2024-8-13 21:52
的确有问题，请参考。。。

我修改后，替换了下数值，点了下按钮还是出现打开弹出
是不是需要把替换的word打开
但是我打开后就卡住了


2

gwjkkkkk

地球炒蛋 发表于 2024-8-13 22:01
我修改后，替换了下数值，点了下按钮还是出现打开弹出
是不是需要把替换的word打开
但是我打开后就卡住 ...

估计是wps的关系吧。。。