Ошибка несоответствия типа в vba при поиске и обновлении - PullRequest
0 голосов
/ 30 мая 2020

Приведенный ниже код выдает Runtime Error: 13 Type mismatch. У меня есть список тысяч URL-адресов в Sheet3, column A, где я запускаю свой сценарий vba. Он находит каждый из URL-адресов в Sites, column B из 300 книг, находящихся в папке. Если найдено, column E той же строки обновляется на Yes.

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 Variant
Dim FoundNo As String

strReplace = "Yes"
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
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
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Set FoundCell = wsh.Range("B:B").Find(What:=Cells(i, "A").Value, LookAt:=xlWhole, MatchCase:=False)
       If Not FoundCell Is Nothing Then
     FoundNo = FoundCell.Address
       Debug.Print FoundCell.Address
       Do Until FoundCell Is Nothing
   wsh.Cells(FoundCell.Row, 5).Value = strReplace
   Set FoundCell = wsh.Cells.FindNext(after:=FoundCell)
   If FoundCell.Address = FoundNo Then Exit Do
   Loop
   End If
    Next i
    End If
    Next wsh
    wbk.Close SaveChanges:=True
    strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...