VBA查找满足条件的记录

请问哪位朋友知道,VBA实现查找出工作表内所有满足条件的行,并替换指定的单元格内容?

Sub ReplaceConditional()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim rng As Range
    Set rng = ws.Range("A1:D10")

    Dim cell As Range
    For Each cell In rng
        If cell.Value = "foo" Then
            cell.Value = "bar"
        End If
    Next cell
End Sub

Option Explicit
Option Compare Text

Sub 关键字查找工作簿行()
    'Application.DisplayAlerts = False
    Dim i1, i2, i3, i4, i5, i6, i7, b, j
    Dim wb2 As Workbook
    Dim eachSheet As Worksheet
    Dim inpu As String
    '选择多个文件
    Dim l As Long
    Dim full_file
    b = 2
    On Error Resume Next '忽略运行过程中可能出现的错误
    Set wb2 = ThisWorkbook

    MsgBox "通过关键字查找工作簿的行,如查找关键字:合计、汇总、总计……。查找时部分匹配,不是全匹配。查找不同工作簿中的多个工作表。汇总到工作表《汇总各表行》中,保留数值、格式,不保留公式。"
    inpu = Application.InputBox("请输入需要查找的关键字(如合计、汇总等),是按照部分匹配查找,输入字符串必须准确,否则查找结果太多容易导致死锁:", Type:=2)

    Dim sht As Worksheet '定义对象变量sht,用于表示工作表
    On Error Resume Next '容错语句
    Set sht = Sheets("汇总各表行") '将“成绩统计表”赋值给对象变量sht
    If Err <> 0 Then '如果表格不存在,上面的赋值操作会出错,Err<>0表示有错误
        Sheets.Add(, Sheets(Sheets.Count)).Name = "汇总各表行" '新建在最后面
    Else
        Debug.Print "该表已经存在" '如果没出错,说明表格存在,给出提示
    End If


    With Application.FileDialog(msoFileDialogFilePicker) '要全选ctrl + A
        .AllowMultiSelect = True
        '单选择
        .Filters.Clear
        '清除文件过滤器
        .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlw"
        .Filters.Add "All Files", "*.*"
        '设置两个文件过滤器
        .Show
        For l = 1 To .SelectedItems.Count
            full_file = .SelectedItems(l)
            'Debug.Print full_file
            Dim wkbk As Workbook  '定义一个工作薄
            Set wkbk = Workbooks.Open(full_file) '打开文件
    
            
            For Each eachSheet In wkbk.Worksheets
                
    
                If Not eachSheet.Name = "汇总各表行" Then

                    'Debug.Print eachSheet.UsedRange.Rows.Count, eachSheet.UsedRange.Columns.Count

                    j = eachSheet.UsedRange.Columns.Count


                    For i1 = 1 To eachSheet.UsedRange.Rows.Count '从第1行到最大行

                        For i2 = 1 To j '从第1列到最大列

                            If eachSheet.Cells(i1, i2) <> "" Then '如果单元格不是空白,则

                                i3 = InStr(1, eachSheet.Cells(i1, i2), inpu) '获取关键词所在位置
                                
                                i6 = InStr(1, eachSheet.Cells(i1, i2), "洁")
                                
             
                                If i6 > 0 Then '如果不存在关键词,则退出。因为复制一整行,不能保证同一行的其他单元格不含有i6所包含的字符串。
                                    Exit For
                                Else:

                                    If i3 > 0 Then '如果存在关键词,则
    
                                        eachSheet.Range(Cells(i1, 1), Cells(i1, j)).Copy
    
                                        wb2.Worksheets("汇总各表行").Cells(b, 3).PasteSpecial Paste:=xlPasteFormats
    
                                        wb2.Worksheets("汇总各表行").Cells(b, 3).PasteSpecial Paste:=xlPasteValues
    
                                        wb2.Worksheets("汇总各表行").Cells(b, 2).Value = eachSheet.Name
                                        wb2.Worksheets("汇总各表行").Cells(b, 1).Value = wkbk.Name
    
                                        b = b + 1
    
                                        'Debug.Print wkbk.Name, eachSheet.Name, j
    
                                        Exit For '退出For循环
                                End If

                                End If

                            End If

                        Next

                    Next
                 End If
            Next
            wkbk.Save: wkbk.Close True
        Next
    End With

    Application.DisplayAlerts = True
End Sub

参考 VBA 查找和替换: https://blog.csdn.net/weixin_42298128/article/details/112629254

你看看这篇实例中讲解的方法符合你的要求不?

Sub replacetest()

Dim str As String
Dim str2 As String
str = "ababab"
'vba.Replace("在哪儿找","找什么(需要被替换掉的部分)","换成什么","从第几个字符开始找","替换几次","匹配方式")
'一共六个参数
'例1
str2 = Replace(str, "a", 1)
'把str中的全部替换为1
'str2 会被替换成1b1b1b

'例2
str2 = Replace(str, "a", 1, 3)
'第四个参数说明从第3个字符开始替换,替换结果会舍掉前两个字符。
'str2会被替换成1b1b

'例3
str2 = Replace(str, "a", 1, 3, 1)
'第五个参数是替换次数,默认是替换全部,设置为1的话,就只替换第一次出现的a;
'这句代码的意思是从第3个开始的第1个a
'str2会被替换为1bab

'例4
str2 = Replace(str, "A", 1, , , vbBinaryCompare)
'第六个参数为二进制匹配时,区分大小写;结果为ababab
str2 = Replace(str, "A", 1, , , vbTextCompare)
'第六个参数为文本匹配时,不区分大小写;结果为1b1b1b

MsgBox str2
End Sub