Выделения цветом несовпадающих фрагментов строк (Excel, VBA)

@ykr · Регистрация: 11.01.2019

Студворк — интернет-сервис помощи студентам

Добрый день! Задача сравнения строк в Excel (VBA) и выделения цветом несовпадающих фрагментов строк.
Посмотрел решения и нужного как-то не нашел. В файле есть код, который ближе всего к желаемому, нашел в инете.
Например, сравниваем строки :
1) Мама мыла раму и 2) Мама намылила раму - результат, цветом выделяется : намылила раму
Вроде как почти правильно, но по идее выделен должен быть текст: "намылила"

Т.е находится несовпадение и выделяется строка цветом с этого места и до конца, и сравнение строк и выделение цветом после нахождения совпадения не до конца корректный.
Слово "рама" есть и в строке 1 и 2, его не нужно цветом выделять.

или
1) Мама мыла раму и 2) мама намылила раму - выделено цветом: "мама намылила раму"
Играет роль регистр.

А если вставлять в строки пробелы или запятые , типа : мама намылила, раму
то результат вообще неправильный.

Может кто видел более интеллектуальное решение?
Чтобы цветом выделялось именно несовпадение строк и не более того, и не важно, где оно найдено вначале строки, в середине или конце.
И чтобы был выбор - искать "НЕ совпадение в строках" или "Совпадение в строках".
И чтобы запятые и лишние пробелы(вначале строк, в конце и между словами) исключить из поиска или, чтобы они не влияли таким кардинальным образом, что ответ становится по сути неприемлемым.
Спасибо!

I can · 17.07.2025, 18:16

Сообщение от ykr

В файле есть код

В каком файле?

I can · 17.07.2025, 18:27

Сообщение от ykr

Может кто видел более интеллектуальное решение?

Это наверное тот случай, когда лучше использовать нейросеть. Главное - поставить правильно её задачу.

Выделения цветом несовпадающих фрагментов строк (Excel, VBA)

@ykr · 17.07.2025, 18:35 **[ТС]**

не мог понять , почему файл не прикладывается, хотя он расширения rar ?

согласен и насчет ИИ тоже думал, но хочется и код иметь под рукой!

@MikeVol · 17.07.2025, 23:26

Сообщение от ykr

мама намылила, раму

А что по вашему необходимо выделить если будет такая же строка но без запятой, мама намылила раму ?

@ykr · 18.07.2025, 09:30 **[ТС]**

А что по вашему необходимо выделить если будет такая же строка но без запятой, мама намылила раму ?

Думаю, что необходимо выделить - намылила

Вообще нужно решить как быть с регистром, пробелами и запятыми и ввести их как входные параметры в функцию или подпрограмму.
1).Чтобы модно было выбирать - учитывать регистр при сравнении или нет.
2). Учитывать наличие пробелов или нет?
Но, что имеется ввиду? Если будет написано все без пробелов, то это слишком и за это и браться не стоит - "мамамылараму"
Но если написано - "мама мыла раму" - то пробелы больше одного видимо не нужно учитывать и отбрасывать при сравнении.
3). По запятым - их лучше сделать входным параметров - хочешь учитывай, хочешь нет.

В приведенном коде программы идет по-позиционнное и посимвольное сравнение.
Если во второй строке поставить перед первым словом пробел, то сразу пострадает все сравнение, вот такого конечно быть не должно.

I can · 18.07.2025, 11:13

ykr, делать такое без ИИ - дохлый номер.

@KoGG · 18.07.2025, 15:11

Старая наработка, можно взять за основу и переделать под данную задачу:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Function QuickEquality(ByVal t1, ByVal t2) As Single
'Функция выдает процент похожести по началам слов, по количеству совпавших символов, деленных на общее число символов без пробелов.
'Знаки препинания и отдельные специальные символы удаляются из подсчета
'Если все слова совпадают, а изменен только порядок - выдает 1 (т.е. 100%. )
    Dim i%, j%, k%, S, Z, L%, N1%, N2%
    Dim Max1%(), Max2%(), Sum%
    ClearPunctuation t1
    ClearPunctuation t2
    S = Split(t1, " "): Z = Split(t2, " ")
    N1 = UBound(S): N2 = UBound(Z)
    ReDim Max1(0 To N1), Max2(0 To N2)
    For i = 0 To N1
        L = Len(S(i))
        For j = 0 To N2
            For k = L To IIf(Max1(i) > 2, Max1(i), 2) Step -1
                If Left(S(i), k) = Left(Z(j), k) Then
                    If Max1(i) <= k And Max2(j) <= k Then Max1(i) = k: Max2(j) = k
                    Exit For
                End If
            Next
        Next j
        Sum = Sum + Max1(i)
    Next i
    t1 = Replace$(t1, " ", "")
    t2 = Replace$(t2, " ", "")
    QuickEquality = Sum / IIf(Len(t1) > Len(t2), Len(t1), Len(t2))
End Function
Sub ClearPunctuation(t)
    Dim i%
    t = Replace(t, ".", " ")
    t = Replace(t, ",", " ")
    t = Replace(t, ";", " ")
    t = Replace(t, ":", " ")
    t = Replace(t, "»", " ")
    t = Replace(t, "«", " ")
    t = Replace(t, "–", " ")
    t = Replace(t, "+", " ")
    t = Replace(t, "№", " ")
    t = Replace(t, Chr$(10), " ")
    t = Replace(t, Chr$(13), " ")
    t = Replace(t, Chr$(160), " ")
    t = Replace(t, "(", " ")
    t = Replace(t, ")", " ")
    t = Replace(t, """", " ")
    For i = 1 To 10: t = Replace(t, "  ", " "): Next
End Sub

Добавлено через 10 минут
а выделять отдельные символы в ячейке можно так :

Visual Basic
1
Activecell.Characters(Start:=3, Length:=7).Font.Color = vbRed

Добавлено через 31 минуту

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub test_Покрасить_несовпадения()
    Покрасить_несовпадения ActiveSheet.Range("B24"), ActiveSheet.Range("B25")
End Sub
 
Sub Покрасить_несовпадения(RaObrazec As Range, RaCel As Range)
    Dim t1$, t2$
    Dim i%, j%, k%, S, Z, L%, N1%, N2%
    Dim Ravny() As Boolean, Sum%
    t1 = RaObrazec.Value
    t2 = RaCel.Value
    ClearPunctuation t1
    ClearPunctuation t2
    S = Split(t1, " "): Z = Split(t2, " ")
    N1 = UBound(S): N2 = UBound(Z)
    ReDim Ravny(0 To N2)
    For i = 0 To N1
        For j = 0 To N2
            If S(i) = Z(j) Then
                Ravny(j) = True
                Exit For
            End If
        Next j
    Next i
    t2 = RaCel.Value
    For j = 0 To N2
        If Ravny(j) = False Then
            k = InStr(1, t2, Z(j))
            N2 = Len(Z(j))
            RaCel.Characters(Start:=k, Length:=N2).Font.Color = vbRed
        End If
    Next j
End Sub
Sub ClearPunctuation(t)
    Dim i%
    t = Replace(t, ".", " ")
    t = Replace(t, ",", " ")
    t = Replace(t, ";", " ")
    t = Replace(t, ":", " ")
    t = Replace(t, "»", " ")
    t = Replace(t, "«", " ")
    t = Replace(t, "–", " ")
    t = Replace(t, "+", " ")
    t = Replace(t, "№", " ")
    t = Replace(t, Chr$(10), " ")
    t = Replace(t, Chr$(13), " ")
    t = Replace(t, Chr$(160), " ")
    t = Replace(t, "(", " ")
    t = Replace(t, ")", " ")
    t = Replace(t, """", " ")
    For i = 1 To 10: t = Replace(t, "  ", " "): Next
End Sub

Добавлено через 7 минут
- это код для простых случаев (нет включений слов "мамамамам" , нет повторений слов) и без дополнительных хотелок.
Для сложных - надо тщательнее искать выделяемые позиции символов в ячейке с учетом особых случаев или изначально запоминать позиции до очистки от лишних знаков и лишних пробелов.

@ykr · 18.07.2025, 15:46 **[ТС]**

KoGG, спасибо, попробую приладить и отпишусь!

@KoGG · 21.07.2025, 14:36

Для игнорирования регистра в начале модуля до процедур декларация:

Visual Basic
1
Option Compare Text

Добавлено через 5 часов 13 минут
С решением проблем повторных слов и частичного совпадения слов:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
Option Compare Text
 
Sub test_Покрасить_несовпадения()
    Покрасить_несовпадения [A1], [A2]
End Sub
 
Sub Покрасить_несовпадения(RaObrazec As Range, RaCel As Range)
    Dim t1$, t2$, t2a$
    Dim i%, j%, k%, S, Z, N1%, N2%
    Dim Ravny1() As Boolean, Ravny2() As Boolean, Sum%
    t1 = RaObrazec.Value
    t2a = RaCel.Value
    If Trim(t1) = "" Or Trim(t2a) = "" Then Exit Sub
    ClearPunctuation t1
    ZamenaPunctuation t2a
    t2 = t2a
    SjatProbely t2
    S = Split(t1, " "): Z = Split(t2, " ")
    N1 = UBound(S): N2 = UBound(Z)
    ReDim Ravny1(0 To N1), Ravny2(0 To N2)
    For i = 0 To N1
        For j = 0 To N2
            If Ravny1(i) = False And Ravny2(j) = False Then
                If S(i) = Z(j) Then
                    Ravny1(i) = True
                    Ravny2(j) = True
                    Exit For
                End If
            End If
        Next j
    Next i
    t2a = " " & t2a & " "
    RaCel.Font.ColorIndex = xlAutomatic
    For j = 0 To N2
        If Ravny2(j) = False Then
            S = " " & Z(j) & " "
            k = InStr(1, t2a, S)
            If k > 0 Then
                N1 = Len(Z(j))
                RaCel.Characters(Start:=k, Length:=N1).Font.Color = vbRed
            End If
        End If
    Next j
End Sub
 
Sub ClearPunctuation(t)
    ZamenaPunctuation t
    SjatProbely t
End Sub
 
Sub ZamenaPunctuation(t)
    t = Replace(t, ".", " ")
    t = Replace(t, ",", " ")
    t = Replace(t, ";", " ")
    t = Replace(t, ":", " ")
    t = Replace(t, "»", " ")
    t = Replace(t, "«", " ")
    t = Replace(t, "–", " ")
    t = Replace(t, "+", " ")
    t = Replace(t, "№", " ")
    t = Replace(t, Chr$(10), " ")
    t = Replace(t, Chr$(13), " ")
    t = Replace(t, Chr$(160), " ")
    t = Replace(t, "(", " ")
    t = Replace(t, ")", " ")
    t = Replace(t, """", " ")
End Sub
 
Sub SjatProbely(t)
    Do
        t = Replace(t, "  ", " ")
    Loop While InStr(1, t, "  ") > 0
End Sub

Новые блоги и статьи Все статьи Все блоги /
сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .
Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и источниками (напряжения, ЭДС и тока). Найти токи и напряжения во всех элементах. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и. . .

@ykr 3 / 3 / 2 Регистрация: 11.01.2019 Сообщений: 125

	Выделения цветом несовпадающих фрагментов строк (Excel, VBA) 17.07.2025, 18:11. Показов 1783. Ответов 9 Метки нет (Все метки) Добрый день! Задача сравнения строк в Excel (VBA) и выделения цветом несовпадающих фрагментов строк. Посмотрел решения и нужного как-то не нашел. В файле есть код, который ближе всего к желаемому, нашел в инете. Например, сравниваем строки : 1) Мама мыла раму и 2) Мама намылила раму - результат, цветом выделяется : намылила раму Вроде как почти правильно, но по идее выделен должен быть текст: "намылила" Т.е находится несовпадение и выделяется строка цветом с этого места и до конца, и сравнение строк и выделение цветом после нахождения совпадения не до конца корректный. Слово "рама" есть и в строке 1 и 2, его не нужно цветом выделять. или 1) Мама мыла раму и 2) мама намылила раму - выделено цветом: "мама намылила раму" Играет роль регистр. А если вставлять в строки пробелы или запятые , типа : мама намылила, раму то результат вообще неправильный. Может кто видел более интеллектуальное решение? Чтобы цветом выделялось именно несовпадение строк и не более того, и не важно, где оно найдено вначале строки, в середине или конце. И чтобы был выбор - искать "НЕ совпадение в строках" или "Совпадение в строках". И чтобы запятые и лишние пробелы(вначале строк, в конце и между словами) исключить из поиска или, чтобы они не влияли таким кардинальным образом, что ответ становится по сути неприемлемым. Спасибо! 0

@ykr 3 / 3 / 2 Регистрация: 11.01.2019 Сообщений: 125
	18.07.2025, 09:30 [ТС]
	А что по вашему необходимо выделить если будет такая же строка но без запятой, мама намылила раму ? Думаю, что необходимо выделить - намылила Вообще нужно решить как быть с регистром, пробелами и запятыми и ввести их как входные параметры в функцию или подпрограмму. 1).Чтобы модно было выбирать - учитывать регистр при сравнении или нет. 2). Учитывать наличие пробелов или нет? Но, что имеется ввиду? Если будет написано все без пробелов, то это слишком и за это и браться не стоит - "мамамылараму" Но если написано - "мама мыла раму" - то пробелы больше одного видимо не нужно учитывать и отбрасывать при сравнении. 3). По запятым - их лучше сделать входным параметров - хочешь учитывай, хочешь нет. В приведенном коде программы идет по-позиционнное и посимвольное сравнение. Если во второй строке поставить перед первым словом пробел, то сразу пострадает все сравнение, вот такого конечно быть не должно. 0

I can sleep 4920 / 4566 / 839 Регистрация: 13.04.2015 Сообщений: 9,717
	18.07.2025, 11:13
	ykr, делать такое без ИИ - дохлый номер. 0

@ykr 3 / 3 / 2 Регистрация: 11.01.2019 Сообщений: 125
	18.07.2025, 15:46 [ТС]
	KoGG, спасибо, попробую приладить и отпишусь! 0

Выделения цветом несовпадающих фрагментов строк (Excel, VBA)

Решение