[已解决]按sheet1的B列值查找并替换整个工作簿所有工作表并将特定值填入每个工作表指定列

su77

各位大神：      在实际应用中，遇到以下的问题希望通过VBA来提高效率：
1.按shee1表里定位内容（A2的内容31A000-000A(2225011)）在整个工作簿中每个工作表的【B列】里查找，若存在定位内容，则在对应的工作表里将对应的【K列】值替换为此表更改内容的值（B2的内容WXB-WWS-ZP）；定位内容31A000-000A(2225011)也可能存在工作表中的F列，则不用执行替换内容与更改标注;2.同时在对应行的最后一列将更改标注（C2的内容GGTZ-2023013 2023.2.17）填入，因为定位内容会存在多个标注，例如sheet4中0列与N列均已存在标注，故将GGTZ-2023013 2023.2.17填入P列，而sheet3中0列不存在标注，故将GGTZ-2023013 2023.2.17填入0列；3.更改的内容与更改标注需按此表对应的底色标注对应工作表。
       实际中整个工作簿上百个工作表，一个个查找与替换太费时间，望各位有经验的帮忙写个代码，万分感谢！

最佳答案

月排行榜 / 总排行榜

excel用账户

2023-2-20 16:46

su77 发表于 2023-2-22 09:31
非常感谢您的代码，是我需要的！再请教一个问题，如果想要统计替换的个数，应该如何加代码？

1. Sub ts()
   
2. Dim a
   
3. a = Sheets(1).Cells(2, 1) '获取表1A2单元格值
   
4. For i = 2 To Sheets.Count '表2开始历遍工作表
   
5. k = Sheets(i).UsedRange.Columns.Count '获取表i最后一个行号
   
6. For j = 1 To Sheets(i).UsedRange.Rows.Count '表i内循环
   
7. If Sheets(i).Range("B" & j) = a And Sheets(i).Range("F" & j) <> a Then '对比B列值是否相等且F列不等
   
8. Sheets(1).Range("B2").Copy Sheets(i).Range("K" & j) '复制表1B2到K列
   
9. Sheets(1).Range("C2").Copy Sheets(i).Cells(j, k + 1) '复制表1C2到最后一行
   
10. p = p + 1 '替换个数+1
    
11. End If
    
12. Next
    
13. Next
    
14. MsgBox "替换个数：" & p
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

excel用账户

su77 发表于 2023-2-22 09:31
非常感谢您的代码，是我需要的！再请教一个问题，如果想要统计替换的个数，应该如何加代码？

1. Sub ts()
   
2. Dim a
   
3. a = Sheets(1).Cells(2, 1) '获取表1A2单元格值
   
4. For i = 2 To Sheets.Count '表2开始历遍工作表
   
5. k = Sheets(i).UsedRange.Columns.Count '获取表i最后一个行号
   
6. For j = 1 To Sheets(i).UsedRange.Rows.Count '表i内循环
   
7. If Sheets(i).Range("B" & j) = a And Sheets(i).Range("F" & j) <> a Then '对比B列值是否相等且F列不等
   
8. Sheets(1).Range("B2").Copy Sheets(i).Range("K" & j) '复制表1B2到K列
   
9. Sheets(1).Range("C2").Copy Sheets(i).Cells(j, k + 1) '复制表1C2到最后一行
   
10. p = p + 1 '替换个数+1
    
11. End If
    
12. Next
    
13. Next
    
14. MsgBox "替换个数：" & p
    
15. End Sub
    

复制代码

excel用账户

1. Sub ts()
   
2.     Dim a
   
3.     a = Sheets(1).Cells(2, 1) '获取表A2单元格值
   
4.         For i = 2 To Sheets.Count '表1开始历遍工作表
   
5.             For j = 1 To Sheets(i).UsedRange.Rows.Count '表i内循环
   
6.                 If Sheets(i).Range("B" & j) = a And Sheets(i).Range("F" & j) <> a Then '对比B列值是否相等且F列不等
   
7.                     Sheets(1).Range("B2").Copy Sheets(i).Range("K" & j) '复制表1B2到K列
   
8.                     k = Sheets(i).UsedRange.Columns.Count '获取表i最后一个行号
   
9.                     Sheets(1).Range("C2").Copy Sheets(i).Cells(j, k + 1) '复制表1C2到最后一行
   
10.                 End If
    
11.             Next
    
12.         Next
    
13. End Sub

复制代码

su77

excel用账户 发表于 2023-2-21 09:54

非常感谢您的代码，是我需要的！再请教一个问题，如果想要统计替换的个数，应该如何加代码？

su77

excel用账户 发表于 2023-2-22 09:58

明白了，谢谢！