Здравствуйте. Нигде не могу найти решения подобной задачи. Имеется книга с данными, большинство из коотрых отредактированы (отформатированы тем или иным образом). И есть другая книга, в которой те же данные, только после некоторой коррекции в исходной программе (откуда через txt файл выгружаются эти данные и переносятся в эксель). Там что-то было добавлено, что-то удалено, но большинство одинаково. Нужно сравнить строки в этих книгах и при полностью идентичных первых 5-ти ячейках строки перенести формат (у меня это выделение цветом, добавление даты и значения в последних ячейках строки) из строк первой книги в строки второй. Неплохо было бы еще выделить новые строки. Подобную процедуру выполнять приходится последнее время часто, и иногда число строк достигает нескольких тысяч, но пока не нашел решения для автоматизации процесса.
Здравствуйте. Нигде не могу найти решения подобной задачи. Имеется книга с данными, большинство из коотрых отредактированы (отформатированы тем или иным образом). И есть другая книга, в которой те же данные, только после некоторой коррекции в исходной программе (откуда через txt файл выгружаются эти данные и переносятся в эксель). Там что-то было добавлено, что-то удалено, но большинство одинаково. Нужно сравнить строки в этих книгах и при полностью идентичных первых 5-ти ячейках строки перенести формат (у меня это выделение цветом, добавление даты и значения в последних ячейках строки) из строк первой книги в строки второй. Неплохо было бы еще выделить новые строки. Подобную процедуру выполнять приходится последнее время часто, и иногда число строк достигает нескольких тысяч, но пока не нашел решения для автоматизации процесса.drugojandrew
Sub fi() Dim m, m1, r As Range, r1 As Range, i&, ii&, n&, n1&, i1&, ii1&, s$, s1$ Dim WB As Workbook, WB1 As Workbook Set WB = ActiveWorkbook n = Cells(Rows.Count, 1).End(xlUp).Row: Set r = Range("a1:e" & n): m = r.Value
Set WB1 = Workbooks("С форматированием.xls") With WB1 n1 = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row: Set r1 = .Sheets(1).Range("a1:e" & n1): m1 = r1.Value End With
For i = 1 To n s = vbNullString For ii = 1 To 5: s = s & (m(i, ii)): Next For i1 = 1 To n1 s1 = vbNullString For ii1 = 1 To 5: s1 = s1 & (m1(i1, ii1)): Next If s1 = s Then With r1: Range(.Cells(i1, 1), .Cells(i1, 5)).Copy: End With With r: Range(.Cells(i, 1), .Cells(i, 5)).PasteSpecial xlPasteFormats: End With Exit For End If Next Next End Sub
[/vba]
Запускать из новой книги. Оба файла должны быть открыты.
Попробуйте макрос: [vba]
Код
Sub fi() Dim m, m1, r As Range, r1 As Range, i&, ii&, n&, n1&, i1&, ii1&, s$, s1$ Dim WB As Workbook, WB1 As Workbook Set WB = ActiveWorkbook n = Cells(Rows.Count, 1).End(xlUp).Row: Set r = Range("a1:e" & n): m = r.Value
Set WB1 = Workbooks("С форматированием.xls") With WB1 n1 = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row: Set r1 = .Sheets(1).Range("a1:e" & n1): m1 = r1.Value End With
For i = 1 To n s = vbNullString For ii = 1 To 5: s = s & (m(i, ii)): Next For i1 = 1 To n1 s1 = vbNullString For ii1 = 1 To 5: s1 = s1 & (m1(i1, ii1)): Next If s1 = s Then With r1: Range(.Cells(i1, 1), .Cells(i1, 5)).Copy: End With With r: Range(.Cells(i, 1), .Cells(i, 5)).PasteSpecial xlPasteFormats: End With Exit For End If Next Next End Sub
[/vba]
Запускать из новой книги. Оба файла должны быть открыты. SLAVICK
SLAVICK, спасибо! Это то что надо. Как бы теперь еще скопировать ячейки "F" и "G" при одинаковых первых пяти ячейках строки. Понимаю что примерно то же самое, только добавить копирование, но в VBA пока не силен (только- только начинаю что-то делать) и у самого реализовать не получается. Можете помочь с этим? [moder]Это уже другой вопрос, значит, другая тема[/moder]
SLAVICK, спасибо! Это то что надо. Как бы теперь еще скопировать ячейки "F" и "G" при одинаковых первых пяти ячейках строки. Понимаю что примерно то же самое, только добавить копирование, но в VBA пока не силен (только- только начинаю что-то делать) и у самого реализовать не получается. Можете помочь с этим? [moder]Это уже другой вопрос, значит, другая тема[/moder]drugojandrew
Сообщение отредактировал Pelena - Вторник, 08.09.2015, 12:20
Sub fi() Dim m, m1, r As Range, r1 As Range, i&, ii&, n&, n1&, i1&, ii1&, s$, s1$ Dim WB As Workbook, WB1 As Workbook Set WB = ActiveWorkbook n = Cells(Rows.Count, 1).End(xlUp).Row: Set r = Range("a1:g" & n): m = r.Value
Set WB1 = Workbooks("С форматированием.xls") With WB1 n1 = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row: Set r1 = .Sheets(1).Range("a1:g" & n1): m1 = r1.Value End With
For i = 1 To n s = vbNullString For ii = 1 To 5: s = s & (m(i, ii)): Next For i1 = 1 To n1 s1 = vbNullString For ii1 = 1 To 5: s1 = s1 & (m1(i1, ii1)): Next If s1 = s Then With r1: Range(.Cells(i1, 1), .Cells(i1, 7)).Copy: End With With r: Range(.Cells(i, 1), .Cells(i, 7)).PasteSpecial xlPasteFormats: End With Exit For End If Next Next End Sub
Нужно сравнить строки в этих книгах и при полностью идентичных первых 5-ти ячейках строки перенести формат .... из строк первой книги в строки второй.
Поменял в коде всего 4-е символа [vba]
Код
Option Explicit
Sub fi() Dim m, m1, r As Range, r1 As Range, i&, ii&, n&, n1&, i1&, ii1&, s$, s1$ Dim WB As Workbook, WB1 As Workbook Set WB = ActiveWorkbook n = Cells(Rows.Count, 1).End(xlUp).Row: Set r = Range("a1:g" & n): m = r.Value
Set WB1 = Workbooks("С форматированием.xls") With WB1 n1 = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row: Set r1 = .Sheets(1).Range("a1:g" & n1): m1 = r1.Value End With
For i = 1 To n s = vbNullString For ii = 1 To 5: s = s & (m(i, ii)): Next For i1 = 1 To n1 s1 = vbNullString For ii1 = 1 To 5: s1 = s1 & (m1(i1, ii1)): Next If s1 = s Then With r1: Range(.Cells(i1, 1), .Cells(i1, 7)).Copy: End With With r: Range(.Cells(i, 1), .Cells(i, 7)).PasteSpecial xlPasteFormats: End With Exit For End If Next Next End Sub
... перенести формат (у меня это выделение цветом, добавление даты и значения в последних ячейках строки)
Этим я хотел сказать, что в новый файл нужно скопировать форматирование уже имеющихся а так же добавленных в строку ячеек, и ещё значения в них (добавленных ячейках) содержащиеся.
Pelena, SLAVICK прав. Может я как-то неточно выразился. У меня написано так:
... перенести формат (у меня это выделение цветом, добавление даты и значения в последних ячейках строки)
Этим я хотел сказать, что в новый файл нужно скопировать форматирование уже имеющихся а так же добавленных в строку ячеек, и ещё значения в них (добавленных ячейках) содержащиеся.drugojandrew
Ну да - это я недопонял - согласен, что это другой вопрос. Я сделал только формат... поиск и подстановка значений = другая тема Но забегая наперед скажу: drugojandrew, для этого в код нужно добавить всего две строки, или поменять существующую одну - можете попробовать самостоятельно
Ну да - это я недопонял - согласен, что это другой вопрос. Я сделал только формат... поиск и подстановка значений = другая тема Но забегая наперед скажу: drugojandrew, для этого в код нужно добавить всего две строки, или поменять существующую одну - можете попробовать самостоятельно SLAVICK
Иногда все проще чем кажется с первого взгляда.
Сообщение отредактировал SLAVICK - Вторник, 08.09.2015, 16:27
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
