Здравствуйте! Раньше лопатил таблицу вручную, но теперь объем данных увеличился и нужна автоматизация, так как другой работы полно. Прошу подсказать решение: например, кинуть ссылку на похожее решение. Поиском не нашел... (или плохо искал). Задача. Имеем две колонки со списками слов и словосочетаний, каждая из которых имеет числовое значение в соседней колонке. Один набор данных старый (справа), уже размеченный необходимым цветом, а другой - новый (слева). Так как в новой колонке список постоянно увеличивается, то необходимо определить ячейки с одинаковыми словами в новом наборе данных и окрасить в цвета, соответствующие старым данным. Неокрашенные ячейки и будут вновь выявленными. Прием с окрашиванием очень важен. Во вложении пример: в первой вкладке конечный результат, а во второй - исходник.
Здравствуйте! Раньше лопатил таблицу вручную, но теперь объем данных увеличился и нужна автоматизация, так как другой работы полно. Прошу подсказать решение: например, кинуть ссылку на похожее решение. Поиском не нашел... (или плохо искал). Задача. Имеем две колонки со списками слов и словосочетаний, каждая из которых имеет числовое значение в соседней колонке. Один набор данных старый (справа), уже размеченный необходимым цветом, а другой - новый (слева). Так как в новой колонке список постоянно увеличивается, то необходимо определить ячейки с одинаковыми словами в новом наборе данных и окрасить в цвета, соответствующие старым данным. Неокрашенные ячейки и будут вновь выявленными. Прием с окрашиванием очень важен. Во вложении пример: в первой вкладке конечный результат, а во второй - исходник.vitzer
Sub Colored() i = 2 While ActiveSheet.Cells(i, 5).Value <> "" k = 2 While (ActiveSheet.Cells(k, 1).Value <> "") And (ActiveSheet.Cells(k, 1).Value <> ActiveSheet.Cells(i, 5).Value) k = k + 1 Wend
If ActiveSheet.Cells(k, 1).Value = ActiveSheet.Cells(i, 5).Value Then
ActiveSheet.Cells(k, 1).Interior.Pattern = ActiveSheet.Cells(i, 5).Interior.Pattern ActiveSheet.Cells(k, 1).Interior.PatternColorIndex = ActiveSheet.Cells(i, 5).Interior.PatternColorIndex ActiveSheet.Cells(k, 1).Interior.ColorIndex = ActiveSheet.Cells(i, 5).Interior.ColorIndex ActiveSheet.Cells(k, 1).Interior.Color = ActiveSheet.Cells(i, 5).Interior.Color If ActiveSheet.Cells(i, 5).Interior.ThemeColor > 0 Then ActiveSheet.Cells(k, 1).Interior.ThemeColor = ActiveSheet.Cells(i, 5).Interior.ThemeColor End If ActiveSheet.Cells(k, 1).Interior.TintAndShade = ActiveSheet.Cells(i, 5).Interior.TintAndShade ActiveSheet.Cells(k, 1).Interior.PatternTintAndShade = ActiveSheet.Cells(i, 5).Interior.PatternTintAndShade End If i = i + 1 Wend End Sub
[/vba]
Только что-то мне подсказывает что в примере не совсем корректно раскрасили ячейки. Опять таки в задании надо раскрашивать правую, а в примере наоборот - левую колонку. Короче макрос красит лекую колонку по образцу правой. Если надо наоборот, то во всех адресах ячеек Cells(...., 1) поменять 1 на 5, и 5 на 1 . ЗЫЖ взаимное расположение данных (т.е в каких колонках и с каких строк начинается, для макроса - важно!
Пожалуйста... [vba]
Код
Sub Colored() i = 2 While ActiveSheet.Cells(i, 5).Value <> "" k = 2 While (ActiveSheet.Cells(k, 1).Value <> "") And (ActiveSheet.Cells(k, 1).Value <> ActiveSheet.Cells(i, 5).Value) k = k + 1 Wend
If ActiveSheet.Cells(k, 1).Value = ActiveSheet.Cells(i, 5).Value Then
ActiveSheet.Cells(k, 1).Interior.Pattern = ActiveSheet.Cells(i, 5).Interior.Pattern ActiveSheet.Cells(k, 1).Interior.PatternColorIndex = ActiveSheet.Cells(i, 5).Interior.PatternColorIndex ActiveSheet.Cells(k, 1).Interior.ColorIndex = ActiveSheet.Cells(i, 5).Interior.ColorIndex ActiveSheet.Cells(k, 1).Interior.Color = ActiveSheet.Cells(i, 5).Interior.Color If ActiveSheet.Cells(i, 5).Interior.ThemeColor > 0 Then ActiveSheet.Cells(k, 1).Interior.ThemeColor = ActiveSheet.Cells(i, 5).Interior.ThemeColor End If ActiveSheet.Cells(k, 1).Interior.TintAndShade = ActiveSheet.Cells(i, 5).Interior.TintAndShade ActiveSheet.Cells(k, 1).Interior.PatternTintAndShade = ActiveSheet.Cells(i, 5).Interior.PatternTintAndShade End If i = i + 1 Wend End Sub
[/vba]
Только что-то мне подсказывает что в примере не совсем корректно раскрасили ячейки. Опять таки в задании надо раскрашивать правую, а в примере наоборот - левую колонку. Короче макрос красит лекую колонку по образцу правой. Если надо наоборот, то во всех адресах ячеек Cells(...., 1) поменять 1 на 5, и 5 на 1 . ЗЫЖ взаимное расположение данных (т.е в каких колонках и с каких строк начинается, для макроса - важно!dim34rus
Извращение - это писать формулы в Word'овских таблицах. ЯД 410014340958327
Сообщение отредактировал dim34rus - Среда, 21.12.2016, 02:04
Sub colorize() Dim cell As Range With Application .ScreenUpdating = 0: .EnableEvents = 0 On Error Resume Next For Each cell In [A2].Resize([counta(A:A)]).Cells .CutCopyMode = False [E:E].Find(cell, , xlValues, xlWhole).Copy cell.PasteSpecial xlPasteAll Next .ScreenUpdating = 1: .EnableEvents = 1 End With End Sub
[/vba]
еще вариант [vba]
Код
Sub colorize() Dim cell As Range With Application .ScreenUpdating = 0: .EnableEvents = 0 On Error Resume Next For Each cell In [A2].Resize([counta(A:A)]).Cells .CutCopyMode = False [E:E].Find(cell, , xlValues, xlWhole).Copy cell.PasteSpecial xlPasteAll Next .ScreenUpdating = 1: .EnableEvents = 1 End With End Sub