EXCEL VBA批量替换问题

万里孤舟

关于VBA批量替换的问题：请老师帮忙看一下为什么代码不能将所有工作表中的F01-40A320L 批量替换成F23-C000002-00？我执行以后只能将当前工作表替换。想要将整个文件夹里的所有excel文件里的 （整个工作簿的）F01-40A320L 批量替换成F23-C000002-00 应该如何实现？
Sub OpenCloseArray()
    Dim MyFile As String
    Dim Arr(100) As String
    Dim count As Integer
    Application.AskToUpdateLinks = False
        MyFile = Dir("D:\Users\2018090145\Desktop\test\" & "*.xls*")
    count = count + 1
    Arr(count) = MyFile

    Do While MyFile <> ""
    MyFile = Dir
        If MyFile = "" Then
        Exit Do
        End If
    count = count + 1
    Arr(count) = MyFile
    Loop
    For i = 1 To count
    Workbooks.Open Filename:="D:\Users\2018090145\Desktop\test\" & Arr(i)
        Cells.Replace What:="F01-40A320L", Replacement:="F23-C000002-00", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = True
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next
    MsgBox "批量替换完成"
End Sub

taller

参考代码

1. Sub OpenCloseArray()
   
2.     Dim MyFile As String
   
3.     Dim Arr(100) As String
   
4.     Dim count As Integer
   
5.     Application.AskToUpdateLinks = False
   
6.     MyFile = Dir("D:\Users\2018090145\Desktop\test" & "*.xls*")
   
7.     count = count + 1
   
8.     Arr(count) = MyFile
   
9. 
   
10.     Do While MyFile <> ""
    
11.         MyFile = Dir
    
12.         If MyFile = "" Then
    
13.             Exit Do
    
14.         End If
    
15.         count = count + 1
    
16.         Arr(count) = MyFile
    
17.     Loop
    
18.     For i = 1 To count
    
19.         Set wk = Workbooks.Open(Filename:="D:\Users\2018090145\Desktop\test" & Arr(i))
    
20.         wk.ActiveSheet.Cells.Replace What:="F01-40A320L", Replacement:="F23-C000002-00", LookAt _
    
21.                                                                           :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    
22.                       ReplaceFormat:=False
    
23.         Application.DisplayAlerts = False
    
24.         Application.AskToUpdateLinks = True
    
25.         wk.Save
    
26.         wk.Close
    
27.     Next
    
28.     MsgBox "批量替换完成"
    
29. End Sub
    
30. 
    

复制代码

万里孤舟

老师，我按上面的代码执行了一遍，同一个工作簿里的还是不能全部替换掉。执行只更新了工作表1的，可是"排站"那个工作表情里的内容没有更新过来。是不是因为弹出"此工作簿包含未更新的链接"而导致中断了执行啊？

taller

替换全部工作表，需要再加一层循环

1. Sub OpenCloseArray()
   
2.     Dim MyFile As String
   
3.     Dim Arr(100) As String
   
4.     Dim count As Integer
   
5.     Application.AskToUpdateLinks = False
   
6.     MyFile = Dir("D:\Users\2018090145\Desktop\test" & "*.xls*")
   
7.     count = count + 1
   
8.     Arr(count) = MyFile
   
9. 
   
10.     Do While MyFile <> ""
    
11.         MyFile = Dir
    
12.         If MyFile = "" Then
    
13.             Exit Do
    
14.         End If
    
15.         count = count + 1
    
16.         Arr(count) = MyFile
    
17.     Loop
    
18.     Application.DisplayAlerts = False
    
19.     Application.AskToUpdateLinks = False
    
20.     For i = 1 To count
    
21.         Set wk = Workbooks.Open(Filename:="D:\Users\2018090145\Desktop\test" & Arr(i))
    
22.         For Each sht In wk.Sheets
    
23.             sht.Cells.Replace What:="F01-40A320L", Replacement:="F23-C000002-00", LookAt _
    
24.                   :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    
25.                   ReplaceFormat:=False
    
26. 
    
27.         Next
    
28.         wk.Save
    
29.         wk.Close
    
30.     Next
    
31.     MsgBox "批量替换完成"
    
32. End Sub
    
33. 
    
34. 
    

复制代码

万里孤舟

谢谢老师 搞定了。

microyip

1. Sub OpenCloseArray()
   
2.     Dim MyFile As String
   
3.     Dim Arr(100) As String
   
4.     Dim count As Integer, i As Integer
   
5.     Dim wSH As Worksheet, wWB As Workbook
   
6.    
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Application.AskToUpdateLinks = False
   
10.    
    
11.     MyFile = Dir("D:\Users\2018090145\Desktop\test" & "*.xls*")
    
12. 
    
13.     Do While MyFile <> "" And count < 100
    
14.         count = count + 1
    
15.         Arr(count) = MyFile
    
16.         MyFile = Dir
    
17.     Loop
    
18.     For i = 1 To count
    
19.         Set wWB = Workbooks.Open(Filename:="D:\Users\2018090145\Desktop\test" & Arr(i))
    
20.         With wWB
    
21.             For Each wSH In .Sheets
    
22.                 With wSH
    
23.                     .Cells.Replace What:="F01-40A320L", Replacement:="F23-C000002-00", LookAt:=xlPart, SearchOrder:=xlByRows, _
    
24.                         MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
25.                 End With
    
26.             Next
    
27.             .Save
    
28.             .Close False
    
29.         End With
    
30.     Next
    
31.     Application.DisplayAlerts = True
    
32.     Application.AskToUpdateLinks = True
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "批量替换完成"
    
35. End Sub

复制代码