Добрый день! Есть два списка организаций. Необходимо их сравнить и выделить различия в тексте. Если можно, то формулой. В примере намеренно заменил русскую "А" на английскую "А". Заранее спасибо!
Добрый день! Есть два списка организаций. Необходимо их сравнить и выделить различия в тексте. Если можно, то формулой. В примере намеренно заменил русскую "А" на английскую "А". Заранее спасибо!olegus
Формулой в любом случае нельзя изменить цвет шрифта или сделать другое оформление у отдельных символов в ячейке (можно оформить только ячейку целиком). Поэтому остается макрос. Но макрос можно сделать в виде формулы, если Вам нужна именно формула. У меня просто макрос. Макрос может не показать отличие, если будут лишние (двойные) пробелы, в этом случае пробел нельзя закрасить. [vba]
Код
Sub Сравнить()
Dim arr(), var1, var2, lngStart As Long Dim lr As Long, i As Long, ii As Long, iii As Long
If UBound(var1) <> UBound(var2) Then Cells(i, "D").Value = "разное кол-во слов" GoTo metka End If
Cells(i, "D").Value = Cells(i, "B").Value
For ii = 0 To UBound(var1)
If var1(ii) = var2(ii) Then lngStart = lngStart + Len(var2(ii)) + 1 ElseIf Len(var1(ii)) <> Len(var2(ii)) Then If Len(var2(ii)) <> 0 Then Cells(i, "D").Characters(lngStart, Len(var2(ii))).Font.Color = vbRed End If lngStart = lngStart + Len(var2(ii)) + 1 Else For iii = 1 To Len(var1(ii)) If Mid(var1(ii), iii, 1) <> Mid(var2(ii), iii, 1) Then Cells(i, "D").Characters(lngStart, 1).Font.Color = vbRed End If lngStart = lngStart + 1 Next lngStart = lngStart + 1 End If
Next
metka: Next
Application.ScreenUpdating = True
End Sub
[/vba]
Формулой в любом случае нельзя изменить цвет шрифта или сделать другое оформление у отдельных символов в ячейке (можно оформить только ячейку целиком). Поэтому остается макрос. Но макрос можно сделать в виде формулы, если Вам нужна именно формула. У меня просто макрос. Макрос может не показать отличие, если будут лишние (двойные) пробелы, в этом случае пробел нельзя закрасить. [vba]
Код
Sub Сравнить()
Dim arr(), var1, var2, lngStart As Long Dim lr As Long, i As Long, ii As Long, iii As Long
If UBound(var1) <> UBound(var2) Then Cells(i, "D").Value = "разное кол-во слов" GoTo metka End If
Cells(i, "D").Value = Cells(i, "B").Value
For ii = 0 To UBound(var1)
If var1(ii) = var2(ii) Then lngStart = lngStart + Len(var2(ii)) + 1 ElseIf Len(var1(ii)) <> Len(var2(ii)) Then If Len(var2(ii)) <> 0 Then Cells(i, "D").Characters(lngStart, Len(var2(ii))).Font.Color = vbRed End If lngStart = lngStart + Len(var2(ii)) + 1 Else For iii = 1 To Len(var1(ii)) If Mid(var1(ii), iii, 1) <> Mid(var2(ii), iii, 1) Then Cells(i, "D").Characters(lngStart, 1).Font.Color = vbRed End If lngStart = lngStart + 1 Next lngStart = lngStart + 1 End If
Подскажите пожалуйста, как изменится макрос, если допустим в двух ячейках по одному слову, но с разным количеством букв. Нужно чтобы выделялись красным цветом только различия (файлик во вложении)
Добрый день.
Подскажите пожалуйста, как изменится макрос, если допустим в двух ячейках по одному слову, но с разным количеством букв. Нужно чтобы выделялись красным цветом только различия (файлик во вложении)flaviy
flaviy, - Прочитайте Правила форума - Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 500 кб согласно п.3 Правил форума - Создайте свою тему согласно п.5q Правил форума
flaviy, - Прочитайте Правила форума - Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 500 кб согласно п.3 Правил форума - Создайте свою тему согласно п.5q Правил форумакитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852