Макрос сравнения текста в массиве - VBA
Формулировка задачи:
Есть такая задача: найти в столбике D ячейку и сравнить её с остальными ячейками в этом же столбике на совпадение текста(в процентном соотношении). Дальше необходимо полученный процент поставить в найденной строке в столбик М. Например берем ячейку D36 и сравниваем со всеми ячейками в столбике D. Допустим совпадение текста D36 и D75 40%. Эту цифру мы вставляем в ячейку М75.
На данный момент нашла вроде бы подходящий код, но он не работает. Подскажите что я не так указала либо предложите свой вариант (только можно с комментами, а то мне учиться надо же как-то).
Дальше в идеале нужно было сделать отборку и первые 10 строк с максимальным совпадением переместить на другой лист, но эту часть кода я пока не сделала(уже сделанное не работает). Если эту отборку можно сделать вируально, без исправлений в файле, то подскажите этот вариант,пожалуйста.
P.S. Так как загрузить можно файл не больше 100 кб, то файл во вложении ОЧЕНЬ обрезан и совпадения на нем могут быть минимальны
Листинг программы
- 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
Решение задачи: «Макрос сравнения текста в массиве»
textual
Листинг программы
- v = Val / Val1 * 100 ' âû÷èñëÿåì ïðîöåГ*ГІ
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д