VBA: ошибка несоответствия типов при поиске элементов из другого списка

Question

Я работаю над приведенным ниже упражнением, но мне нужна помощь. Это дает ошибку времени выполнения 13. Я новичок, не могли бы вы помочь мне решить ее? Конечно, другие способы решения проблемы более чем приветствуются. Существует 2 списка (1: Sheet2.Range ("E5: E1324") и 2: SearchRange = Sheet1.Range ("F2: F4178")), с длинным текстовым форматом и не точным соответствием, список 1 содержит фразу информация в списке2. Мне нужно знать, сколько раз данные в списке 2 упоминаются в списке 1 (поскольку я знаю, что иногда они доходят до 7) Большое спасибо, Ана

Sub countvalues()
' count how many times data in Description Range is listed in SearchRange

Dim i As Integer 'for looping in Description
Dim j As Integer   'for looping in SearchRange
Dim Counter As Integer
Dim FoundData As Range
Dim Description As Range
Dim SearchRange As Range

Set Description = Sheet2.Range("E5:E1324")
Set SearchRange = Sheet1.Range("F2:F4178")

Application.ScreenUpdating = False
Counter = 0

For i = 5 To 1324   'trying with a narrower range for testing purpose

        For j = 2 To 4178
            Set FoundData = SearchRange.Find(Sheet2.Range("E" & i))
            'On Error Resume Next
            Counter = FoundData.Count + 1

        Next j

    Sheet2.Range("F" & i) = Counter

Next i

Application.ScreenUpdating = True

End Sub

Answer 1

Попробуйте адаптированный код, пожалуйста. Это будет работать только в том случае, если ваша строка, используемая для поиска (What), содержится в ячейках диапазона поиска ... Я имею в виду, что "искомый поиск" будет найден в "тестовом поиске сегодня". Но «поиск проверен сегодня» не будет найден в «поиске проверен»

Sub testFindSimilar()
 Dim d As Long, strFirstAddress As String
 Dim Counter As Long, lastR1 As Long, lastR2 As Long
 Dim shD As Worksheet, shS As Worksheet, cel As Range

  Set shD = sheet1
  Set shS = sheet2
  lastR1 = shS.Range("F" & Rows.Count).End(xlUp).Row
  lastR2 = shD.Range("E" & Rows.Count).End(xlUp).Row

 For d = 5 To lastR2
    Set cel = shS.Range("F2:F" & lastR1).Find(What:=shD.Range("E" & d).value, _
                      After:=shS.Range("F2"), LookIn:=xlValues, SearchOrder:=xlByRows, LookAt:=xlPart)
    If Not cel Is Nothing Then
        strFirstAddress = cel.Address
        Do
            Set cel = shS.Range("F2:F" & lastR1).FindNext(cel)
            If Not cel Is Nothing Then
                Counter = Counter + 1
            End If
        Loop Until cel.Address = strFirstAddress
    End If
    shD.Range("F" & d).value = Counter
    Counter = 0: strFirstAddress = ""
 Next d
End Sub

Если вы хотите проверять меньшее количество строк, вы можете заменить переменную последних строк вашими номерами тестирования.