[已解决]求高手指点，如何批量修改或替换多个EXCEL表内内容

2480698122

有多个Excel表，希望把这个模具型号的产品换个材料，名称和型号是判断条件，只改变材料，如把aab-01的锁定轴的材料PP换成ABS,并能同时批量修改其他表。

最佳答案

月排行榜 / 总排行榜

chart888

2017-8-9 08:48

2480698122 发表于 2017-8-9 08:35
谢谢老师 老师你能把代码注释下吗 有几段看不懂

1. Private Sub CommandButton1_Click()
   
2. Dim MyPath$, MyName$, Sh As Workbook
   
3. Dim i&
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. 
   
8. MyPath = ThisWorkbook.Path & ""
   
9. MyName = Dir(MyPath & "*.*")
   
10. r = 0 '记录修改个数，所以起始为0
    
11. Do While MyName <> "" '当文件名不为空时进行以下操作
    
12.     If MyName <> ThisWorkbook.Name Then '跳过当前工作表
    
13.         Set Sh = GetObject(MyPath & MyName) '打开工作簿
    
14.         With Sh.ActiveSheet '引用打开的工作簿的默认工作表
    
15.             For i = 6 To 25 '左边区域的数据是从第6行开始到25行结束，所以从第6行开始往下循环
    
16.                 If .Cells(i, 2) = "锁定轴" And .Cells(i, 3) = "ABB-01" And .Cells(i, 4) <> "ABS" Then '判断是否符合条件，符合就进行修正
    
17.                     r = r + 1
    
18.                     .Cells(i, 4) = "ABS"
    
19.                 End If
    
20.             Next
    
21.             For i = 3 To 20 '右边边区域的数据是从第3行开始到20行结束，所以从第3行开始往下循环
    
22.                 If .Cells(i, 16) = "锁定轴" And .Cells(i, 17) = "ABB-01" And .Cells(i, 18) <> "ABS" Then '判断是否符合条件，符合就进行修正
    
23.                     r = r + 1
    
24.                     .Cells(i, 18) = "ABS"
    
25.                 End If
    
26.             Next
    
27.         End With
    
28.         Windows(MyName).Visible = True '关闭隐藏窗口
    
29.         Workbooks(MyName).Close True '关闭工作簿
    
30.     End If
    
31.     MyName = Dir
    
32. Loop
    
33. MsgBox "总计修正" & r & "处数据" '消息框提示修正了几个
    
34. Application.ScreenUpdating = True
    
35. Application.DisplayAlerts = True
    
36. End Sub
    

复制代码

跳转到最佳答案楼层

chart888

表格格式统一吗
就是你列子里面的那样
还是说格式不统一的
所在的列数也不一定的

2480698122

chart888 发表于 2017-8-7 19:33
表格格式统一吗
就是你列子里面的那样
还是说格式不统一的

格式都是一样的 具体的格式在这个表格里  拜托

chart888

2480698122 发表于 2017-8-8 09:59
格式都是一样的 具体的格式在这个表格里  拜托

解压后“修改”文件放在需要修改的文件夹内，点击修改还有你的源文件可能很多自动更新的连接，我这边打开的时候很慢

2480698122

chart888 发表于 2017-8-8 16:19
解压后“修改”文件放在需要修改的文件夹内，点击修改还有你的源文件可能很多自动更新的连接，我这边打开 ...

谢谢老师 老师你能把代码注释下吗 有几段看不懂

chart888

2480698122 发表于 2017-8-9 08:35
谢谢老师 老师你能把代码注释下吗 有几段看不懂

1. Private Sub CommandButton1_Click()
   
2. Dim MyPath$, MyName$, Sh As Workbook
   
3. Dim i&
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. Application.DisplayAlerts = False
   
7. 
   
8. MyPath = ThisWorkbook.Path & ""
   
9. MyName = Dir(MyPath & "*.*")
   
10. r = 0 '记录修改个数，所以起始为0
    
11. Do While MyName <> "" '当文件名不为空时进行以下操作
    
12.     If MyName <> ThisWorkbook.Name Then '跳过当前工作表
    
13.         Set Sh = GetObject(MyPath & MyName) '打开工作簿
    
14.         With Sh.ActiveSheet '引用打开的工作簿的默认工作表
    
15.             For i = 6 To 25 '左边区域的数据是从第6行开始到25行结束，所以从第6行开始往下循环
    
16.                 If .Cells(i, 2) = "锁定轴" And .Cells(i, 3) = "ABB-01" And .Cells(i, 4) <> "ABS" Then '判断是否符合条件，符合就进行修正
    
17.                     r = r + 1
    
18.                     .Cells(i, 4) = "ABS"
    
19.                 End If
    
20.             Next
    
21.             For i = 3 To 20 '右边边区域的数据是从第3行开始到20行结束，所以从第3行开始往下循环
    
22.                 If .Cells(i, 16) = "锁定轴" And .Cells(i, 17) = "ABB-01" And .Cells(i, 18) <> "ABS" Then '判断是否符合条件，符合就进行修正
    
23.                     r = r + 1
    
24.                     .Cells(i, 18) = "ABS"
    
25.                 End If
    
26.             Next
    
27.         End With
    
28.         Windows(MyName).Visible = True '关闭隐藏窗口
    
29.         Workbooks(MyName).Close True '关闭工作簿
    
30.     End If
    
31.     MyName = Dir
    
32. Loop
    
33. MsgBox "总计修正" & r & "处数据" '消息框提示修正了几个
    
34. Application.ScreenUpdating = True
    
35. Application.DisplayAlerts = True
    
36. End Sub
    

复制代码

2480698122

chart888 发表于 2017-8-9 08:48

谢谢老师  这个只能修改同个文件夹下的表格   有没有办法能同时修改其他文件夹中的表呢？