[已解决]区域搜索替换的宏

承诺与谁

因为工作需要 ， 表有几种，需要区域搜索替换。（替换要求：因为我想一次全部替换，包括有文本框里的文字。表格有几种，替换的内容都不一样）

比如表中的A 替换成B ，S替换成D。F替换成G。
但是有个表中没有A ，这个宏就是错误的。（重点、重点、重点）。
录制了几次。都是错误的

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-5 16:11

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
4. Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
5. myPath = ThisWorkbook.Path & ""          '把文件路径定义给变量
   
6. myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   
7. Do While myFile <> ""                     '当指定路径中有文件时进行循环
   
8.     If myFile <> ThisWorkbook.Name Then
   
9.         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
   
10.         m = ActiveSheet.UsedRange.Rows.Count
    
11.         n = ActiveSheet.UsedRange.Columns.Count
    
12.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="A", Replacement:="b", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
13.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="s", Replacement:="d", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
14.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="f", Replacement:="g", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
15.         Workbooks(myFile).Close savechanges:=True               '关闭源工作簿
    
16.     End If
    
17.     myFile = Dir                                   '找寻下一个*.xls文件
    
18. Loop
    
19. Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
20. MsgBox "替换完成，请查看！", 64, "提示"
    
21. End Sub

复制代码

跳转到最佳答案楼层

池盛龙

上附件看看，这样很难明白你意思

承诺与谁

表格已经上传。  有两个表格。有两个最终希望能通过宏来达到的表格。一共四个表格。感谢帮助

chart888

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
4. Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
5. myPath = ThisWorkbook.Path & ""          '把文件路径定义给变量
   
6. myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   
7. Do While myFile <> ""                     '当指定路径中有文件时进行循环
   
8.     If myFile <> ThisWorkbook.Name Then
   
9.         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
   
10.         m = ActiveSheet.UsedRange.Rows.Count
    
11.         n = ActiveSheet.UsedRange.Columns.Count
    
12.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="A", Replacement:="b", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
13.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="s", Replacement:="d", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
14.         AK.ActiveSheet.Range("A1").Resize(m, n).Replace What:="f", Replacement:="g", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
15.         Workbooks(myFile).Close savechanges:=True               '关闭源工作簿
    
16.     End If
    
17.     myFile = Dir                                   '找寻下一个*.xls文件
    
18. Loop
    
19. Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
20. MsgBox "替换完成，请查看！", 64, "提示"
    
21. End Sub

复制代码

承诺与谁

chart888 发表于 2017-6-5 16:11

可以在加一个选取范围吗？比如在10行到20行的范围内

chart888

承诺与谁 发表于 2017-6-8 16:18
可以在加一个选取范围吗？比如在10行到20行的范围内

1. Private Sub CommandButton1_Click()
   
2. Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
3. Dim m1, m2
   
4. Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
5. 
   
6. sInt = Application.InputBox(Prompt:="输入起始行数", Type:=1)
   
7.     If Len(Trim(sInt)) > 0 Then
   
8.         m1 = sInt
   
9.     Else
   
10.       MsgBox Prompt:="您没有输入有效的行数" & Chr(10) _
    
11.             & "正确的月份格式为:(例:1)", Buttons:=vbOKOnly + vbInformation, _
    
12.             Title:="错误提示"
    
13.             Exit Sub
    
14.     End If
    
15. sInt = Application.InputBox(Prompt:="输入起始行数", Type:=1)
    
16.     If Len(Trim(sInt)) > 0 Then
    
17.         m2 = sInt
    
18.     Else
    
19.       MsgBox Prompt:="您没有输入有效的行数" & Chr(10) _
    
20.             & "正确的月份格式为:(例:1)", Buttons:=vbOKOnly + vbInformation, _
    
21.             Title:="错误提示"
    
22.             Exit Sub
    
23.     End If
    
24. myPath = ThisWorkbook.Path & ""          '把文件路径定义给变量
    
25. myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
    
26. Do While myFile <> ""                     '当指定路径中有文件时进行循环
    
27.     If myFile <> ThisWorkbook.Name Then
    
28.         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
    
29.         m = ActiveSheet.UsedRange.Rows.Count
    
30.         n = ActiveSheet.UsedRange.Columns.Count
    
31.         AK.ActiveSheet.Cells(m1, 1).Resize(m2 - m1 + 1, n).Replace What:="A", Replacement:="b", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
32.         AK.ActiveSheet.Cells(m1, 1).Resize(m2 - m1 + 1, n).Replace What:="s", Replacement:="d", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
33.         AK.ActiveSheet.Cells(m1, 1).Resize(m2 - m1 + 1, n).Replace What:="f", Replacement:="g", LookAt:=xlPart, MatchCase:=False, MatchByte:=False
    
34.         Workbooks(myFile).Close savechanges:=True               '关闭源工作簿
    
35.     End If
    
36.     myFile = Dir                                   '找寻下一个*.xls文件
    
37. Loop
    
38. Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
39. MsgBox "替换完成，请查看！", 64, "提示"
    
40. End Sub

复制代码

满意给个最佳

承诺与谁

chart888 发表于 2017-6-5 16:11

区域范围我已经找到了。麻烦大神能说下这个代码能替换工作簿中的所有工作表吗？（代码是多少呢）还是说只有第一个工作表？

chart888

承诺与谁 发表于 2017-6-8 16:42
区域范围我已经找到了。麻烦大神能说下这个代码能替换工作簿中的所有工作表吗？（代码是多少呢）还是说只 ...

如果需要可以追加
加一个在工作表循环就好

承诺与谁

chart888 发表于 2017-6-8 16:43
如果需要可以追加
加一个在工作表循环就好

大神！我想这个VBA 能够替换文件夹下（包含下属的子文件夹的EXCEL文件），需要怎样的代码呢？谢谢，十分感谢