Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сравнение текста и выделение отличий. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Сравнение текста и выделение отличий. (Формулы/Formulas)
Сравнение текста и выделение отличий.
olegus Дата: Пятница, 30.09.2016, 11:55 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 45
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!
Есть два списка организаций. Необходимо их сравнить и выделить различия в тексте.
Если можно, то формулой.
В примере намеренно заменил русскую "А" на английскую "А".
Заранее спасибо!
К сообщению приложен файл: 1033119.xlsx(9Kb)
 
Ответить
СообщениеДобрый день!
Есть два списка организаций. Необходимо их сравнить и выделить различия в тексте.
Если можно, то формулой.
В примере намеренно заменил русскую "А" на английскую "А".
Заранее спасибо!

Автор - olegus
Дата добавления - 30.09.2016 в 11:55
Karataev Дата: Пятница, 30.09.2016, 16:37 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 641
Репутация: 226 ±
Замечаний: 0% ±

Excel
Формулой в любом случае нельзя изменить цвет шрифта или сделать другое оформление у отдельных символов в ячейке (можно оформить только ячейку целиком). Поэтому остается макрос. Но макрос можно сделать в виде формулы, если Вам нужна именно формула. У меня просто макрос. Макрос может не показать отличие, если будут лишние (двойные) пробелы, в этом случае пробел нельзя закрасить.
[vba]
Код
Sub Сравнить()

    Dim arr(), var1, var2, lngStart As Long
    Dim lr As Long, i As Long, ii As Long, iii As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("A:B").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("A1:B" & lr).Value
    
    For i = 2 To UBound(arr)
    
        lngStart = 1
    
        If arr(i, 1) = arr(i, 2) Then
            GoTo metka
        End If
        
        If arr(i, 1) = "" Or arr(i, 2) = "" Then
            Cells(i, "D").Value = "есть пустые ячейки"
            GoTo metka
        End If
        
        var1 = Split(arr(i, 1), " ")
        var2 = Split(arr(i, 2), " ")
        
        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]




Сообщение отредактировал Karataev - Пятница, 30.09.2016, 16:40
 
Ответить
СообщениеФормулой в любом случае нельзя изменить цвет шрифта или сделать другое оформление у отдельных символов в ячейке (можно оформить только ячейку целиком). Поэтому остается макрос. Но макрос можно сделать в виде формулы, если Вам нужна именно формула. У меня просто макрос. Макрос может не показать отличие, если будут лишние (двойные) пробелы, в этом случае пробел нельзя закрасить.
[vba]
Код
Sub Сравнить()

    Dim arr(), var1, var2, lngStart As Long
    Dim lr As Long, i As Long, ii As Long, iii As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("A:B").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("A1:B" & lr).Value
    
    For i = 2 To UBound(arr)
    
        lngStart = 1
    
        If arr(i, 1) = arr(i, 2) Then
            GoTo metka
        End If
        
        If arr(i, 1) = "" Or arr(i, 2) = "" Then
            Cells(i, "D").Value = "есть пустые ячейки"
            GoTo metka
        End If
        
        var1 = Split(arr(i, 1), " ")
        var2 = Split(arr(i, 2), " ")
        
        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]

Автор - Karataev
Дата добавления - 30.09.2016 в 16:37
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Сравнение текста и выделение отличий. (Формулы/Formulas)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!