Макрос сравнения текста в массиве - VBA

Формулировка задачи:

Есть такая задача: найти в столбике D ячейку и сравнить её с остальными ячейками в этом же столбике на совпадение текста(в процентном соотношении). Дальше необходимо полученный процент поставить в найденной строке в столбик М. Например берем ячейку D36 и сравниваем со всеми ячейками в столбике D. Допустим совпадение текста D36 и D75 40%. Эту цифру мы вставляем в ячейку М75. На данный момент нашла вроде бы подходящий код, но он не работает. Подскажите что я не так указала либо предложите свой вариант (только можно с комментами, а то мне учиться надо же как-то).
Sub ÄÆÊÕ()
'
' ГЊГ*êðîñ Г*Г* Г±Г°Г*ГўГ*ГҐГ*ГЁГҐ ГІГҐГЄГ±ГІГ*
'
 
Dim Svp, lr, i&
lr = Cells(Rows.Count, 4).End(xlUp).Row 'ïîñëåäГ*ГїГї ñòðîêГ*
Svp = [a2].CurrentRegion.Columns(4).Value ' Г¬Г*Г±Г±ГЁГў Г¤Г*Г*Г*ûõ äî ïîñëåäГ*ГҐГ© ñòðîêè
 
For i = 1 To UBound(Svp) ' öèêë ГЇГ® Г¬Г*Г±Г±ГЁГўГі
If Cells.InterColor = vbYellow Then ' åñëè ÿ÷åéêГ* æåëòГ*Гї ГІГ® äåéñòâèå âûïîëГ*ГїГҐГІГ±Гї
    Dim s1 As String, mass As Range
    Dim as1, as2, l1 As Long, l2 As Long, lr As Long
    Dim asStr2
    Dim s As String, s2 As String, lp, lTmpCom As Long, lResCom As Long
    Dim lResR As Long, sResS As String, v
    
    as1 = Split(s1, sDelim)
    asStr2 = mass.Value
    If Not IsArray(asStr2) Then ReDim asStr2(1 To 1, 1 To 1): asStr2(1, 1) = mass.Value
 
    For lr = 1 To UBound(asStr2, 1)
        as2 = Split(asStr2(lr, 1), sDelim)
        lResCom = 0
        For l1 = LBound(as1) To UBound(as1)
            s = as1(l1)
            For l2 = LBound(as2) To UBound(as2)
                If as2(l2) = s Then
                    lResCom = lResCom + 1
                    Exit For
                End If
            Next l2
        Next l1
        If lTmpCom < lResCom Then
            lTmpCom = lResCom
            lResR = lr
            sResS = asStr2(lr, 1)
            lp = lp + 1
        End If
    Next lr
    v = (lTmpCom / (UBound(as1) + 1)) * 100
    Cell(Svp, 13) = v
 
    
End Sub
Дальше в идеале нужно было сделать отборку и первые 10 строк с максимальным совпадением переместить на другой лист, но эту часть кода я пока не сделала(уже сделанное не работает). Если эту отборку можно сделать вируально, без исправлений в файле, то подскажите этот вариант,пожалуйста. P.S. Так как загрузить можно файл не больше 100 кб, то файл во вложении ОЧЕНЬ обрезан и совпадения на нем могут быть минимальны

Код к задаче: «Макрос сравнения текста в массиве - VBA»

textual
v = Val / Val1 * 100 ' âû÷èñëÿåì ïðîöåГ*ГІ

7   голосов, оценка 4.143 из 5


СОХРАНИТЬ ССЫЛКУ