Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.73/15: Рейтинг темы: голосов - 15, средняя оценка - 4.73
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
1

Сравнение диапазонов на НЕ полное совпадение

16.11.2014, 14:03. Просмотров 3090. Ответов 15
Метки нет (Все метки)


Здравствуйте!
Мне требуется помощь в сравнении двух диапазонов.
Находятся диапазоны на разных листах. На первом листе столбец "А" содержит около 3000 значений. На втором листе столбец А содержит около 180 значений. Необходимо сравнить эти два диапазона на частичное совпадение.


Visual Basic
1
2
3
4
5
6
7
8
9
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
Set  CompareRange = Workbooks("Книга1").Worksheets("Лист2").Range("A1:A180")
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Interior.ColorIndex = 3
Next y
Next x
End Sub
В данном виде макрос выделяет цветом только если ячейки полностью совпадают. Нужно чтобы при значении в первом диапазоне "СОБАКА БЕЛАЯ", а во-втором "СОБАКА" - ячейка первого диапазона все равно реагировала и изменяла цвет. Так как кусок кода я нагуглил, то своими силами пока справиться не могу, а гугл в такой узкоспециальной задаче не подсказывает.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
16.11.2014, 14:03
Ответы с готовыми решениями:

Сравнение двух диапазонов ячеек на совпадение
Здравствуйте! Подскажите пожалуйста... Имеется 2 диапазона ячеек А1:A3 и C1:C3, в которых забиты...

Поиск позиции. Не полное совпадение
Здравствуйте форумчане. Что-то не выходит справиться с =ПОИСКПОЗ(). Есть две таблицы....

Полное совпадение при поиске текста
Вот код $file = fopen("db.txt", "r"); $buffer = fread($file, filesize("db.txt")); ...

Сравнить два массива на полное совпадение
Написать программу, сравнивающую два массива на их полное совпадение. то есть нужно сравнивать как...

15
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
16.11.2014, 15:06 2
Если "СОБАКА" находится именно в выделенном диапазоне, то :

Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Sub Find_Matches()
    Dim CompareRange As Range, x As Range, y As Range
    Set CompareRange = Workbooks("Книга1.xls").Worksheets("Лист2").Range("A1:A180")
    For Each x In Selection
        For Each y In CompareRange
            If InStr(1, y, x, vbTextCompare) > 0 Then x.Interior.ColorIndex = 3
            'If y Like "*" & x & "*" Then x.Interior.ColorIndex = 3
        Next y
    Next x
End Sub
Visual Basic
1
2
3
4
5
6
7
8
Private Sub Find_Matches2()
    Dim CompareRange As Range, x As Range
    Set CompareRange = Application.Range("Лист2!A1:A180")
    For Each x In Selection
        If Not CompareRange.Find(CStr(x), , xlFormulas, _
        xlPart) Is Nothing Then x.Interior.ColorIndex = 3
    Next
End Sub
и т.д.
1
84 / 11 / 7
Регистрация: 08.09.2013
Сообщений: 41
16.11.2014, 21:13 3
А вот когда-то была у меня задача сравнивать русские предложения и бухгалтерскую клинопись. Нашел чью-то функцию и допилил немного. Поковыряйтесь, может поможет.
0
Вложения
Тип файла: rar Функция_Нечеткий поиск.rar (27.4 Кб, 29 просмотров)
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
18.11.2014, 17:14  [ТС] 4
Могу ли я попросить вас разъяснить, почему макросов два и что значит "и т.д." Я подозреваю что это что-то очевидное, но я не понимаю.
Еще после введения этих двух макросов у меня перестали отображаться все макросы в меню "макросы", теперь они доступны только после ввода "имени".
0
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
18.11.2014, 17:24 5
  1. Два макроса - это два варианта решения поставленной задачи.
  2. И т.д. означает, что на самом деле, вариантов больше, ибо для поиска можно использовать и другие возможности Excel, например, программно мучить стандартные функции рабочего листа, типа СЧЁТЕСЛИ(), ПОИСКПОЗ()
  3. Не все, а только личные(приватные) и ежели Вас это не устраивает, то уберите ключевое слово Private или замените его на Public (что согласно справке, одно и тоже)
0
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
18.11.2014, 17:58  [ТС] 6
1. Понял спасибо за сразу два варианта.
2. пока что оба варианта работают точно так же как мой код из первого поста. т.е. если в диапазоне А1-А180 второго листа стоит буква "М", то в выделенном диапазоне на первом листе выделяются только буквы "М", а например данные типа "А_М" или "1 М" не выделяются.

Еще вопрос по 7й строчке первого вашего варианта. Это комментарий? Что означает конструкция ( "*" & x & "*" )

3. Разобрался. Спасибо, что так быстро реагируете!

Добавлено через 12 минут
Насколько я понимаю переменные мы задаем как RANGE, а функция InStr используется для строк. Может быть проблема в этом?
0
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
18.11.2014, 18:04 7
2. Совсем не так же в первом макросе заливка будет изменена, только в случае полного совпадения, в моих же макросах "собака" найдётся в списке "белых собак", но не наоборот. С другой стороны, Вы можете использовать два поиска, т.е. If InStr(1, y, x, vbTextCompare) и If InStr(1, x, y, vbTextCompare) (или перебирать ячейки диапазона [А1:А180] и искать эти данные в выделенном диапазоне)

Закомментированная строка - просто представляет собой второй вариант сравнения, т.е. либо функция InStr, либо оператор Like + инструкция Option Compare Text

P.S. Если Вы напишите x.value и y.value ничего не изменится
0
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
18.11.2014, 18:15  [ТС] 8
Все понял как работает, не понимаю почему не работает у меня ((
Вот пример файла который пытаюсь слепить.
Форум почему-то xlsm не пропустил, вложил в архиве.

И спасибо вам огромное за терпение...
0
Вложения
Тип файла: zip Книга1.zip (13.1 Кб, 12 просмотров)
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
18.11.2014, 18:36 9
В Вашем файле наличествуют ячейки, выделенные красным цветом, стало быть макрос работает и ищет данные из ячеек [Лист2!A1:A180] в выделенном диапазоне. Если же Вам необходимо проигнорировать пустые ячейки в выделенном диапазоне, а заодно и убрать цвет заливки, то :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub Find_Matches2()
    Dim CompareRange As Range, x As Range, y As Range
    Set CompareRange = [Лист2!A:A].SpecialCells(xlConstants, xlTextValues)
    
    Selection.Interior.ColorIndex = xlNone
    
    For Each x In CompareRange
        Set y = Selection.Find(CStr(x), , xlValues, xlPart)
        If Not y Is Nothing Then y.Interior.ColorIndex = 3
    Next
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Find_Matches()
    Dim CompareRange As Range, x As Range, y As Range
    Set CompareRange = Worksheets("Лист2").Range("A1:A180")
    
    Selection.Interior.ColorIndex = xlNone
    
    For Each x In Selection
        If Not IsEmpty(x) Then
           For Each y In CompareRange
               If InStr(1, y, x, vbTextCompare) > 0 Then x.Interior.Color = vbRed
           Next y
        End If
    Next x
End Sub
0
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
18.11.2014, 18:44  [ТС] 10
Ищет, все верно, но вот смотрите.
Ячейки А5 (u) и А7(m) подсвечены. А ячейки А9(ur) А15(emt) А16(m re) Не подсвечиваются, хотя и в них присутствуют данные из ячеек [Лист2!A1:A180].
0
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
18.11.2014, 19:06 11
Лучший ответ Сообщение было отмечено without_xp как решение

Решение

Сорри, не заменил повторяющихся символов, из которых поиск находил только первый, собственно, вот это должно Вас устроить …

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Find_Matches()
    Dim CompareRange As Range, x As Range, y As Range
    Set CompareRange = Worksheets("Лист2").Range("A1:A180")
    
    Application.ScreenUpdating = False 'Имеет смысл использ. если выделено много ячеек
    Selection.Interior.ColorIndex = xlNone
    
    For Each y In CompareRange
        If Not IsEmpty(y) Then
           For Each x In Selection
               If InStr(1, x, y, vbTextCompare) > 0 Then x.Interior.Color = vbRed
           Next x
        End If
    Next y
    
    Application.ScreenUpdating = True
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Find_Matches2()
    Dim CompareRange As Range, x As Range, y As Range, a$
    Set CompareRange = [Лист2!A:A].SpecialCells(xlConstants, xlTextValues)
    
    Selection.Interior.ColorIndex = xlNone
    
    For Each x In CompareRange
        Set y = Selection.Find(x, , xlValues, xlPart)
        If Not y Is Nothing Then
           a = y.Address
           Do
                y.Interior.ColorIndex = 3
                Set y = Selection.FindNext(y)
           Loop While y.Address <> a
        End If
    Next
End Sub
1
0 / 0 / 0
Регистрация: 16.11.2014
Сообщений: 6
19.11.2014, 17:52  [ТС] 12
Все заработало!
Надеюсь в будущем я смогу помочь вам так же как вы помогли мне!
Спасибо!
0
0 / 0 / 0
Регистрация: 17.03.2017
Сообщений: 2
17.03.2017, 23:02 13
Добрый вечер!
Никогда не писала макросы и далека от программирования, но необходимо очень срочно и быстро сравнить большое количество файлов excel в них формулы, текст и прочее - это шаблоны налоговой декларации.
Ринулась в интернет, он мне рассказал про макросы, но вот написать так, чтобы получился необходимый эффект, увы, не получается.
Мне надо, чтобы сравнивая два файла Эталон и Второй , во Втором все ячейки, отличные от Эталона были выделены цветом.
0
4111 / 2218 / 938
Регистрация: 01.12.2010
Сообщений: 4,625
18.03.2017, 07:03 14
DK_M, В таких случаях, лучше к вопросу приложить два образца своих файлов (разумеется, не содержащих конфиденциальных данных), и выделить цветом те данные, которые по Вашему мнению и должны быть подсвечены, после выполнения макроса. Причём, если оформить свой вопрос отдельной темой, то количество желающих Вам помочь, может увеличиться.
0
0 / 0 / 0
Регистрация: 17.03.2017
Сообщений: 2
18.03.2017, 23:11 15
Добрый вечер, спасибо за ответ!
Вот пример файла, оставила только один лист, будет 11.
Сравниваем 2 файл с 1, 1 - это эталон.
Нужно, чтобы все изменения в файле 2 были выделены цветом.
Например, строка 29 отличается в файлах.
При этом далее строки не совпадают по нумерации, но совпадают по содержанию
0
Вложения
Тип файла: xls 1.xls (88.5 Кб, 3 просмотров)
Тип файла: xlsx 2.xlsx (47.2 Кб, 0 просмотров)
0 / 0 / 0
Регистрация: 17.12.2019
Сообщений: 9
30.01.2020, 10:11 16
А есть ли возможность как-то данный макрос переделать на полное совпадение ячеек? Только начал практиковаться в VBA, возникла такая необходимость.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
30.01.2020, 10:11

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

как сделать сортировку чтоб получилось полное совпадение
Добрый день! Подскажите, пожалуйста! Есть огромная таблица со множеством строк и столбцов, в ней...

Программа для поиска по тексту в файле(частичное и полное совпадение)
Помогите пожалуйста, дали задание написать программу, а я с C# очень плохо знаком. Задание...

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

Сравнение диапазонов ячеек
Здравствуйте! Простая задача сравнить два диапазона ячеек(A1:A3 и C1:C5), если в одном диапазоне...

Сравнение диапазонов чисел
Здравствуйте форумчане. Не знаю как назвать эту задачу. И даже не знаю как всё это описать. :)...

Сравнение двух диапазонов на несовпадение
Подскажите пожалуйста, как организовать поиск на несовпадение? На первом листе таблицу надо...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
16
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.