整个工作簿所有工作表按B列查找替换特定值到每个工作表指定列

anline1739

各位大神：      在实际应用中，遇到以下的问题希望通过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.更改的内容与更改标注需按此表对应的底色标注对应工作表。
       实际中整个工作簿上百个工作表，一个个查找与替换太费时间，望各位有经验的帮忙写个代码，万分感谢！

3190496160

若定位内容31A000-000A(2225011)存在工作表中的F列，则不用执行替换内容与更改标注;
若存在定位内容，则在对应的工作表里将对应的K列值替换为此表更改内容的值（B2的内容WXB-WWS-ZP）；
楼主认真对照一下这两句话呗，究竟要如何理解？？？？

anline1739

3190496160 发表于 2023-2-20 17:05
若定位内容31A000-000A(2225011)存在工作表中的F列，则不用执行替换内容与更改标注;
若存在定位内容，则在 ...

sheet1里的定位内容在每个工作表的【B列】里查找，若存在定位内容，则在对应的工作表里将对应的【K列】值替换为此表更改内容；定位内容也可能存在每个工作表工作表中的F列，则不用执行替换内容与更改标注，例如sheet5里的F列就有定位内容，但对应的K列不用替换，也不用标注。

ykcbf1100

楼主的需求描述，说得不清晰，猜一个吧。

3190496160

Sub 查找替换()
Dim ar As Variant
Dim rn As Range
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:c" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        For Each sh In Sheets
            If sh.Index > 1 Then
                rs = sh.Cells(Rows.Count, 1).End(xlUp).Row
                Set rn = sh.Range("b5:f" & rs).Find(ar(i, 1), , , , , , 1)
                If Not rn Is Nothing Then
                    h = rn.Column
                    If h = 2 Then
                        x = rn.Row
                        y = sh.Cells(x, Columns.Count).End(xlToLeft).Column + 1
                        sh.Cells(x, 11) = ar(i, 2)
                        sh.Cells(x, 11).Interior.ColorIndex = Sheet1.Cells(i, 2).Interior.ColorIndex
                        sh.Cells(x, y) = ar(i, 3)
                        sh.Cells(x, y).Interior.ColorIndex = Sheet1.Cells(i, 3).Interior.ColorIndex
                    End If
                End If
            End If
        Next sh
    End If
Next i
MsgBox "ok!"
End Sub

3190496160

整个工作簿所有工作表按B列查找替换特定值-230220.rar (27.92 KB, 下载次数: 7)

2023-2-21 08:55 上传

点击文件名下载附件

anline1739

3190496160 发表于 2023-2-21 08:55
Sub 查找替换()
Dim ar As Variant
Dim rn As Range

谢谢，代码整体是对的，目前还有一个问题是更改标注，想要的标注不是从K列开始算，而是从N列（每个工作表的备注列）开始，所以运行结果时sheet3里的备注没内容，应该填在N列，但代码结果会把标注会填在L列。麻烦您看下！

3190496160

anline1739 发表于 2023-2-21 09:37
谢谢，代码整体是对的，目前还有一个问题是更改标注，想要的标注不是从K列开始算，而是从N列（每个工作表 ...

变量y加一个判断不就行了吗，
if y<14 then
y=14
else
y=y

anline1739

3190496160 发表于 2023-2-21 09:40
变量y加一个判断不就行了吗，
if y

明白了，非常感谢！

anline1739

ykcbf1100 发表于 2023-2-21 08:50
楼主的需求描述，说得不清晰，猜一个吧。

谢谢你的代码！