Здравствуйте умельцы! Нужна ваша помощь в решении вопроса через макрос. Excel 2013 Столько всего пересмотрел нет подходящего, а если что то подобное имеется, отсутствуют такие знания для модернизации, поэтому и обращаюсь к Вам.
Имеется Книга 1 (Лист "Сравнение"), состоящая из двух столбцов, она постоянная и находится всегда на одном и том же листе. Вторая таблица, которую надо сравнить с первой, выводится на новый лист в данной книге (Лист N); Необходимо сравнить в таком ключе: Сравниваем постоянную таблицу по первому столбцу по строчно с выводимой, если первый столбец схожий, то проверяем второй столбец и так до конца; Данные расхождения выводить на новый лист: сначало данные листа "Сравнение" и через столбец данные листа N.
Выручайте друзья! Начинал все с макроса, но он не подходит [vba]
Код
Sub сравнение()
Dim i As Long, x As Range, Fst As String Application.ScreenUpdating = False Workbooks("Книга1.xls").Sheets(1).Activate With Workbooks("Книга2.xls").Sheets(1) Columns("A").Interior.ColorIndex = xlNone .Columns("A").Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Set x = .Columns("A").Find(what:=Cells(i, "A"), LookAt:=xlWhole) If Not x Is Nothing Then Cells(i, "A").Interior.ColorIndex = 6 Fst = x.Address Do .Cells(x.Row, "A").Interior.ColorIndex = 6 Set x = .Columns("A").FindNext(x) Loop While Fst <> x.Address End If Next End With
End Sub
[/vba]
Здравствуйте умельцы! Нужна ваша помощь в решении вопроса через макрос. Excel 2013 Столько всего пересмотрел нет подходящего, а если что то подобное имеется, отсутствуют такие знания для модернизации, поэтому и обращаюсь к Вам.
Имеется Книга 1 (Лист "Сравнение"), состоящая из двух столбцов, она постоянная и находится всегда на одном и том же листе. Вторая таблица, которую надо сравнить с первой, выводится на новый лист в данной книге (Лист N); Необходимо сравнить в таком ключе: Сравниваем постоянную таблицу по первому столбцу по строчно с выводимой, если первый столбец схожий, то проверяем второй столбец и так до конца; Данные расхождения выводить на новый лист: сначало данные листа "Сравнение" и через столбец данные листа N.
Выручайте друзья! Начинал все с макроса, но он не подходит [vba]
Код
Sub сравнение()
Dim i As Long, x As Range, Fst As String Application.ScreenUpdating = False Workbooks("Книга1.xls").Sheets(1).Activate With Workbooks("Книга2.xls").Sheets(1) Columns("A").Interior.ColorIndex = xlNone .Columns("A").Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Set x = .Columns("A").Find(what:=Cells(i, "A"), LookAt:=xlWhole) If Not x Is Nothing Then Cells(i, "A").Interior.ColorIndex = 6 Fst = x.Address Do .Cells(x.Row, "A").Interior.ColorIndex = 6 Set x = .Columns("A").FindNext(x) Loop While Fst <> x.Address End If Next End With
_Boroda_, совсем не то, вложение это пример, показатели могут меняться как и цифры(соответственно), поэтому необходимо именно макрос который показыает различие. вторая таблица выводиться также макросом и на нее идет ссылка сравнения(автоматизирую процесс). В примере указал что с чем сравниваем и какой результат получаем.
_Boroda_, совсем не то, вложение это пример, показатели могут меняться как и цифры(соответственно), поэтому необходимо именно макрос который показыает различие. вторая таблица выводиться также макросом и на нее идет ссылка сравнения(автоматизирую процесс). В примере указал что с чем сравниваем и какой результат получаем.Ukh
Sub ertert() Dim rSr As Range, rObr As Range, i As Long With Sheets("сравнение") Set rSr = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) End With With Sheets("Лист2") Set rObr = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) End With With Sheets("Должно быть") For i = 1 To rSr.Rows.Count If Trim(rSr(i, 1)) & Round(rSr(i, 2), 0) <> Trim(rObr(i, 1)) & Round(rObr(i, 2), 0) Then _ .Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 5).Value = _ Array(rSr(i, 1), rSr(i, 2), "", rObr(i, 1), rObr(i, 2)) Next i End With End Sub
[/vba] [offtop]"обробатываемый" - от слова "робить"? :)[/offtop]
разве что как-то вот так: [vba]
Код
Sub ertert() Dim rSr As Range, rObr As Range, i As Long With Sheets("сравнение") Set rSr = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) End With With Sheets("Лист2") Set rObr = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) End With With Sheets("Должно быть") For i = 1 To rSr.Rows.Count If Trim(rSr(i, 1)) & Round(rSr(i, 2), 0) <> Trim(rObr(i, 1)) & Round(rObr(i, 2), 0) Then _ .Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 5).Value = _ Array(rSr(i, 1), rSr(i, 2), "", rObr(i, 1), rObr(i, 2)) Next i End With End Sub
[/vba] [offtop]"обробатываемый" - от слова "робить"? :)[/offtop]nilem
Яндекс.Деньги 4100159601573
Сообщение отредактировал nilem - Пятница, 01.08.2014, 18:24
nilem, не подскажешь, если количество строк больше, он нашел первые два значения, остальные не обработал после того как остановился на отсутствующих значениях, как исправить?
nilem, не подскажешь, если количество строк больше, он нашел первые два значения, остальные не обработал после того как остановился на отсутствующих значениях, как исправить?Ukh
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
