VBA批量搜索更新时触发运行时错误13：类型不匹配求助

嘿，我来帮你搞定这个类型不匹配的问题！这个错误大概率是因为你的代码没有明确指定要读取URL的工作表，导致在打开其他工作簿时引用了错误的单元格内容。下面给你一步步拆解问题和修复方案：

核心问题分析 #

你的代码里Range("A" & Rows.Count).End(xlUp).Row和Cells(i, "A").Value这两处都没指定具体工作表，默认会指向当前活动工作表。但当你循环打开文件夹里的工作簿时，活动工作表会自动切换到新打开的工作簿的表，这时候你本该读取Sheet3里的URL，结果却读了其他工作簿的单元格内容——如果这些内容和要查找的URL类型不匹配，就触发了错误13。

修复后的完整代码 #

我已经帮你修正了工作表引用的问题，还优化了部分逻辑，代码里加了注释说明修改点：

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strReplace As String
    Dim i As Long
    Dim FoundCell As Range ' 将Variant改为Range，类型更明确
    Dim FoundNo As String
    Dim wsURL As Worksheet ' 新增：定义存放URL的工作表对象
    
    strReplace = "Yes"
    ' 指定存放URL的工作表为当前工作簿的Sheet3
    Set wsURL = ThisWorkbook.Worksheets("Sheet3")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\" 
    End If
    
    ' 优化：关闭事件和警报，避免干扰
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            If wsh.Name = "Sites" Then
                ' 限定读取Sheet3的最后一行，避免引用错误工作簿的行数
                For i = 1 To wsURL.Range("A" & wsURL.Rows.Count).End(xlUp).Row
                    ' 确保读取的是Sheet3的A列URL
                    Dim targetURL As Variant
                    targetURL = wsURL.Cells(i, "A").Value
                    
                    ' 跳过空值，避免无效查找
                    If IsEmpty(targetURL) Or targetURL = "" Then
                        GoTo NextURL
                    End If
                    
                    Set FoundCell = wsh.Range("B:B").Find(What:=targetURL, LookAt:=xlWhole, MatchCase:=False)
                    If Not FoundCell Is Nothing Then
                        FoundNo = FoundCell.Address
                        Do
                            wsh.Cells(FoundCell.Row, 5).Value = strReplace
                            Set FoundCell = wsh.Range("B:B").FindNext(after:=FoundCell)
                            ' 避免无限循环：当回到第一个找到的单元格时退出
                        Loop While Not FoundCell Is Nothing And FoundCell.Address <> FoundNo
                    End If
NextURL:
                Next i
            End If
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    
    ' 恢复应用程序设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    MsgBox "所有文件处理完成！", vbInformation
End Sub

关键修改点说明 #

• 新增了wsURL对象，明确指定读取ThisWorkbook.Worksheets("Sheet3")的内容，再也不会因为活动工作表切换而读错数据。
• 将FoundCell的类型从Variant改为Range，类型更明确，减少类型不匹配风险。
• 增加了空值判断，跳过Sheet3里的空URL，避免无效查找。
• 优化了FindNext的循环逻辑，用Do...Loop While替代Do Until，避免循环条件出错。
• 新增了关闭事件和警报的设置，让处理过程更顺畅，不会弹出不必要的弹窗。

额外优化建议 #

如果你的URL数量和工作簿数量都很大，可以考虑把Sheet3的URL先放到数组里，再用数组查找，能大幅提升运行速度：

' 在循环前先把URL存入数组
Dim urlArray As Variant
urlArray = wsURL.Range("A1:A" & wsURL.Range("A" & wsURL.Rows.Count).End(xlUp).Row).Value

' 然后循环数组元素
For i = LBound(urlArray) To UBound(urlArray)
    targetURL = urlArray(i, 1)
    ' 后续查找逻辑不变
Next i

内容的提问来源于stack exchange，提问作者Scitech