Привет, есть проблема. Скрипт должен подтянуть коды цветов шрифтов из другого листа находящийся в другом файле, на котором висит фильтр (Ctrl+Shift+L) , и в этом фильтре отмечены условия отображения. Пример в файлах ( оба файла должны быть открыты, для запуска сделал кнопочку)
Option Explicit Sub ЦветЯчейкиСГ() Dim j As Long Dim i As Long Application.ScreenUpdating = False Range("A4:P1000").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents With Workbooks("СГ.xlsx").Sheets("№2 ЕДИНЫЙ") .Range("$A$4:$Q$1602").AutoFilter Field:=4, Criteria1:="Легк. Авто", Operator:=xlOr, Criteria2:="Недвижимость" For j = 2 To 16 For i = 4 To 1500 Cells(i, 2).Value = .Cells(i, 1).Interior.ColorIndex Cells(i, j).Value = .Cells(i, j).Interior.ColorIndex Next Next
End With Application.ScreenUpdating = True End Sub
Привет, есть проблема. Скрипт должен подтянуть коды цветов шрифтов из другого листа находящийся в другом файле, на котором висит фильтр (Ctrl+Shift+L) , и в этом фильтре отмечены условия отображения. Пример в файлах ( оба файла должны быть открыты, для запуска сделал кнопочку)
Option Explicit Sub ЦветЯчейкиСГ() Dim j As Long Dim i As Long Application.ScreenUpdating = False Range("A4:P1000").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents With Workbooks("СГ.xlsx").Sheets("№2 ЕДИНЫЙ") .Range("$A$4:$Q$1602").AutoFilter Field:=4, Criteria1:="Легк. Авто", Operator:=xlOr, Criteria2:="Недвижимость" For j = 2 To 16 For i = 4 To 1500 Cells(i, 2).Value = .Cells(i, 1).Interior.ColorIndex Cells(i, j).Value = .Cells(i, j).Interior.ColorIndex Next Next
End With Application.ScreenUpdating = True End Sub Alexey200
Сделал, вот рабочий код. Не совсем понятно откуда тут теги брать, взял с кнопки +, .Sub и ./Sub.
Option Explicit Sub ЦветКлетокСГ() Dim j As Long Dim i As Long Application.ScreenUpdating = False Range("A4:P1000").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents With Workbooks("СГ.xlsx").Sheets("№2 ЕДИНЫЙ") .Range("$A$4:$Q$1000").AutoFilter Field:=4, Criteria1:="Легк. Авто", Operator:=xlOr, Criteria2:="Недвижимость"
For j = 2 To 16 For i = 4 To 1000 If .Rows(i).Hidden = False Then Cells(i, 2).Value = .Cells(i, 1).Interior.ColorIndex Cells(i, j).Value = .Cells(i, j).Interior.ColorIndex End If Next Next
End With Application.ScreenUpdating = True End Sub
[offtop]KuklP - не примазывайся к чужим обидам, жалко выглядишь, в особенности когда поступаешь как гнида, удачи, да прибудет с тобой свет создателя.[/offtop]
Сделал, вот рабочий код. Не совсем понятно откуда тут теги брать, взял с кнопки +, .Sub и ./Sub.
Option Explicit Sub ЦветКлетокСГ() Dim j As Long Dim i As Long Application.ScreenUpdating = False Range("A4:P1000").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents With Workbooks("СГ.xlsx").Sheets("№2 ЕДИНЫЙ") .Range("$A$4:$Q$1000").AutoFilter Field:=4, Criteria1:="Легк. Авто", Operator:=xlOr, Criteria2:="Недвижимость"
For j = 2 To 16 For i = 4 To 1000 If .Rows(i).Hidden = False Then Cells(i, 2).Value = .Cells(i, 1).Interior.ColorIndex Cells(i, j).Value = .Cells(i, j).Interior.ColorIndex End If Next Next
End With Application.ScreenUpdating = True End Sub
[offtop]KuklP - не примазывайся к чужим обидам, жалко выглядишь, в особенности когда поступаешь как гнида, удачи, да прибудет с тобой свет создателя.[/offtop]Alexey200
Сообщение отредактировал Alexey200 - Среда, 07.12.2016, 17:10
Слушай урод - посмотри на мою репутацию здесь, на количество постов на Планете. Я помогаю людям. А ты тупое чмо, не умеющее сформулировать задачу, ксенофоб и наглый попрошайка. Давай поклянчь еще, отброс.
Слушай урод - посмотри на мою репутацию здесь, на количество постов на Планете. Я помогаю людям. А ты тупое чмо, не умеющее сформулировать задачу, ксенофоб и наглый попрошайка. Давай поклянчь еще, отброс.KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Сообщение отредактировал KuklP - Среда, 07.12.2016, 17:23
Слушай урод - посмотри на мою репутацию здесь, на количество постов на Планете. Я помогаю людям. А ты тупое чмо, не умеющее сформулировать задачу, ксенофоб и наглый попрошайка. Давай поклянчь еще, отброс.
Не выставляйте свой огромный комплекс неполноценности на показ, хотя бы его территориальную часть, а то прикипело у вас сильно, попой в снег сядь-те. А ваша репутация меркнет от вашего же языка, помогите для начала себе.
Слушай урод - посмотри на мою репутацию здесь, на количество постов на Планете. Я помогаю людям. А ты тупое чмо, не умеющее сформулировать задачу, ксенофоб и наглый попрошайка. Давай поклянчь еще, отброс.
Не выставляйте свой огромный комплекс неполноценности на показ, хотя бы его территориальную часть, а то прикипело у вас сильно, попой в снег сядь-те. А ваша репутация меркнет от вашего же языка, помогите для начала себе.Alexey200
Сообщение отредактировал Alexey200 - Среда, 07.12.2016, 17:52
Лена, нет. Ксенофобов, расистов и прочее хамло я не пропущу молча. Или баньте меня, или эту мразь. Я соглашаюсь, иногда веду себя грубо - но не дай Бог мне, или кому-то при мне коснуться моей нации. Тем паче оскорбить ее.
Лена, нет. Ксенофобов, расистов и прочее хамло я не пропущу молча. Или баньте меня, или эту мразь. Я соглашаюсь, иногда веду себя грубо - но не дай Бог мне, или кому-то при мне коснуться моей нации. Тем паче оскорбить ее.KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
