Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Сравнение данных на разных листах
 
#1
15.11.2011 21:33:51
Добрый день!  
 
В книге на двух листах есть два массива данных, в них могут быть расхождения в любых полях.    
Надо сравнить данные и ту строку, где есть расхождение выделять цветом.  
Прикладываю усеченную таблицу. На практике порядка 4000 строк.  
 
Подскажите, пожалуйста, как это можно реализовать. Только с помощью макросов?
 
 
 
#2
15.11.2011 21:54:12
а ВПР не пробовали?
 
 
 
#3
15.11.2011 21:56:42
4000 - это много....  
Хотя я тут пока то да сё - уже 30% сверил (4000х4000 строк) своим кодом  
http://www.excelworld.ru/index/comparefiles_find/0-25  
или  
http://hugo.nxt.ru/CompareFiles.Find.rar  
 
Настройки под задачу:  
 
 
Файл - приёмник: c:\Temp\fivel\post_278336.xls  
Файл - источник: c:\Temp\fivel\post_278336.xls  
Столбцы сравнения в приёмнике: f,a,b,c,d,e,g  
Столбцы сравнения в источнике: f,a,b,c,d,e,g  
Лист - приёмник (№): 1  
Лист - источник (№): 2  
Столбцы - приёмники данных копирования:  
Столбцы - источники данных копирования:  
Столбец для пометок в приёмнике: i  
Столбец для пометок в источнике: i  
 
Первым сравниваю f как менее повторяющийся.  
Потом по пометкам отобрать и покрасить скопом.  
Но если задача регулярная. то конечно нужно на массивах и словарях делать - сегодня пару вариантов уже выкладывал тут...  
 
О, уже 60%...
 
 
 
#4
16.11.2011 07:15:39
{quote}{login=}{date=15.11.2011 09:54}{thema=}{post}а ВПР не пробовали?{/post}{/quote}  
ВПР - это же, как я понимаю, подтягивание данных из одной таблицы в другую, а мне надо 2 листа сравнить и поля, которые различаются закрасить, например, цветом.  
 
Или я путаю про ВПР?
 
 
 
#5
16.11.2011 07:17:16
{quote}{login=Hugo}{date=15.11.2011 09:56}{thema=}{post}4000 - это много....  
Хотя я тут пока то да сё - уже 30% сверил (4000х4000 строк) своим кодом  
http://www.excelworld.ru/index/comparefiles_find/0-25  
или  
http://hugo.nxt.ru/CompareFiles.Find.rar  
 
Настройки под задачу:  
 
 
Файл - приёмник: c:\Temp\fivel\post_278336.xls  
Файл - источник: c:\Temp\fivel\post_278336.xls  
Столбцы сравнения в приёмнике: f,a,b,c,d,e,g  
Столбцы сравнения в источнике: f,a,b,c,d,e,g  
Лист - приёмник (№): 1  
Лист - источник (№): 2  
Столбцы - приёмники данных копирования:  
Столбцы - источники данных копирования:  
Столбец для пометок в приёмнике: i  
Столбец для пометок в источнике: i  
 
Первым сравниваю f как менее повторяющийся.  
Потом по пометкам отобрать и покрасить скопом.  
Но если задача регулярная. то конечно нужно на массивах и словарях делать - сегодня пару вариантов уже выкладывал тут...  
 
О, уже 60%...{/post}{/quote}  
Спасибо, попробую сегодня.  
Извините, а можно ссылку, где Вы эти примеры на массивах и словарях выкладывали.
 
 
 
#6
16.11.2011 10:17:23
ВПР() подтянет, что найдёт. А где будет ошибка - там не нашёл. Соответственно, по этим результатам и ориентируйтесь.  
Или можно вместо ошибки так и писать: "не нашёл!!!"  
 
А примеры кода тут:  
http://www.planetaexcel.ru/forum.php?thread_id=34009  
Уже 3 разных варианта, один от R Dmitry на SQL/ADO (для разнообразия :) )  
Но нужно конечно переделывать под конкретную задачу.
 
 
 
#7
16.11.2011 11:09:30
Sub ColorRow()  
Dim i As Long, j As Long  
Range("A1").Select  
Selection.End(xlDown).Select  
Selection.Activate  
a = ActiveCell.Row  
Range("A1").Select  
  Do While Not IsEmpty(ActiveCell.Value)  
      ActiveCell.Offset(0, 1).Select  
  Loop  
  Selection.Activate  
  b = ActiveCell.Column - 1  
For i = 2 To a  
   For j = 1 To b  
    Select Case Worksheets("d1").Cells(i, j).Value  
     Case Is <> Worksheets("d2").Cells(i, j).Value  
      Worksheets("d1").Range(Cells(i, 1), Cells(i, b)).Interior.ColorIndex = 3  
    End Select  
   Next j  
Next i  
End Sub
 
 
 
#8
16.11.2011 11:55:07
Тогда уж так, без выделений и активаций. Быстрее.  
Красит все строки, не совпадающие по позициям и по содержимому (как и код выше angrygrey).  
Конкретно в этом коде возможно нужно заменить определение диапазонов с    
CurrentRegion на другое, если есть пустые строки.  
 
 
Sub tt()  
   Dim a(), b(), i, ii  
   a = Worksheets("d1").Cells(1, 1).CurrentRegion.Value  
   b = Worksheets("d2").Cells(1, 1).CurrentRegion.Value  
   Application.ScreenUpdating = False  
   For i = 1 To UBound(a)  
       For ii = 1 To UBound(a, 2)  
           If a(i, ii) <> b(i, ii) Then  
               With Worksheets("d1")  
                   .Range("a" & i, .Cells(i, UBound(a, 2))).Interior.ColorIndex = 3  
               End With  
               Exit For  
               End If  
           Next ii, i  
   Application.ScreenUpdating = True  
End Sub
 
 
 
#9
16.11.2011 12:34:30
Делаю сейчас тоже самое, но в моем примере есть контрольный столбец с уникальной записью (в оригинальном файле и в сравниваемом). Соответственно порядок строк может быть разным.  
Действительно каждый раз нужно подстраиваться под конкретный пример
 
 
 
#10
16.11.2011 12:45:42
{quote}{login=Hugo}{date=16.11.2011 10:17}{thema=}{post}ВПР() подтянет, что найдёт. А где будет ошибка - там не нашёл. Соответственно, по этим результатам и ориентируйтесь.  
Или можно вместо ошибки так и писать: "не нашёл!!!"  
 
Извините, но я что-то не совсем понимаю, ВПР ведь будет подтягивать данные из таблицы, просматривать крайний левый стобец и из соответсвующего столбца доставать данные. И ведь желательно, чтобы в таблице из которой будут тянуться данные, этот крайний (первый) столбец содержал уникальные данные, не ыбло повторенрий. разве не так?????????
 
 
 
#11
16.11.2011 12:46:39
\фига се шутка юмора  
 
For i = 1 To UBound(a)  
For ii = 1 To UBound(a, 2)  
...  
Next ii, i  
 
и ведь работает) Хотя для меня не очень удобно, можно запутаться...
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#12
16.11.2011 12:50:21
Да, тут когда-то встретил, теперь иногда пользуюсь, правда редко.  
Т.к. цикл в цикле редкая штука :)
 
 
 
#13
16.11.2011 12:59:28
Признаться, я уже много всяких штук от Вас и остальных форумчан перенял : )  
Что меня смущает в данной конструкции: отступы (Tab) не поймешь куда ставить, вследствие чего, мозг путаться начинает. Ищет Next по привычке)
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#14
16.11.2011 13:11:10
\немножко абракадабры : )  
 
Sub io()  
Dim j As Byte, i As Byte  
For i = 1 To 10  
   If i > j Then Debug.Print "i - " & i  
       For j = 1 To 11  
       If j > i Then Debug.Print "j - " & j: Exit For  
Next j, i  
End Sub
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#15
16.11.2011 13:12:14
Да, и автомат тоже отступы неверно ставит, сбивает всю красоту :(  
Зато на строчку код короче.  
Но главное - писать меньше :)
 
 
 
#16
16.11.2011 13:12:42
{quote}{login=Hugo}{date=15.11.2011 09:56}{thema=}{post}4000 - это много....  
Хотя я тут пока то да сё - уже 30% сверил (4000х4000 строк) своим кодом  
http://www.excelworld.ru/index/comparefiles_find/0-25  
или  
http://hugo.nxt.ru/CompareFiles.Find.rar  
 
Настройки под задачу:  
 
 
Файл - приёмник: c:\Temp\fivel\post_278336.xls  
Файл - источник: c:\Temp\fivel\post_278336.xls  
Столбцы сравнения в приёмнике: f,a,b,c,d,e,g  
Столбцы сравнения в источнике: f,a,b,c,d,e,g  
Лист - приёмник (№): 1  
Лист - источник (№): 2  
Столбцы - приёмники данных копирования:  
Столбцы - источники данных копирования:  
Столбец для пометок в приёмнике: i  
Столбец для пометок в источнике: i  
 
Первым сравниваю f как менее повторяющийся.  
Потом по пометкам отобрать и покрасить скопом.  
Но если задача регулярная. то конечно нужно на массивах и словарях делать - сегодня пару вариантов уже выкладывал тут...  
 
О, уже 60%...{/post}{/quote}  
попыталась запустить. Выдается ошибка "Run-time error 438"
 
 
 
#17
16.11.2011 13:26:07
Такое было иногда в коде, защищённом VBAProtect - попробуйте скачать сейчас с http://hugo.nxt.ru/CompareFiles.Find.rar  
Там нет этой защиты.  
Но если не пойдёт - значит не судьба...
 
 
 
#18
16.11.2011 13:41:35
Уважаемые, angrygrey и Hugo!  
 
Попробовала Ваши макросы, вроде, все корретно работает. Буду проверять. Наверно появятся вопросы.  
 
Огромное Вам спасибо! Даже как-то неудобно Вашими трудами пользоваться. С меня тортик, если буду в Ваших краях) . Спасибо!
 
 
 
Страницы: 1
Читают тему
Наверх