Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Заливка таблиц макросом - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заливка таблиц макросом (Макросы/Sub)
Заливка таблиц макросом
Mexo Дата: Среда, 12.07.2017, 23:36 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Здравствуйте! Помогите ускорить процесс заливки таблиц! Есть "первая" книга с таблицами в виде залитых в них ячеек тремя цветами: зеленый, желтый,красный. Эти таблицы нужно перенести во "вторую" книгу (копипаст нельзя, т.к. разные форматы ячеек), но только в ней нужно делать заливку одним (синим) цветом. Во второй книге синим цветом нужно залить области таблицы, которые в первой книге залиты зеленым и желтым, остальные области заливать не нужно. Помогите пожалуйста написать макрос чтобы во вторую книгу не заливать в ручную т.к. таблиц почти 2К. Прилагаю 2 файла для примера.
К сообщению приложен файл: 4165447.xlsx (8.4 Kb) · 1405087.xlsx (8.7 Kb)
 
Ответить
СообщениеЗдравствуйте! Помогите ускорить процесс заливки таблиц! Есть "первая" книга с таблицами в виде залитых в них ячеек тремя цветами: зеленый, желтый,красный. Эти таблицы нужно перенести во "вторую" книгу (копипаст нельзя, т.к. разные форматы ячеек), но только в ней нужно делать заливку одним (синим) цветом. Во второй книге синим цветом нужно залить области таблицы, которые в первой книге залиты зеленым и желтым, остальные области заливать не нужно. Помогите пожалуйста написать макрос чтобы во вторую книгу не заливать в ручную т.к. таблиц почти 2К. Прилагаю 2 файла для примера.
Автор - Mexo
Дата добавления - 12.07.2017 в 23:36
Nordheim Дата: Пятница, 14.07.2017, 08:13 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub TablColBlue()
Dim cell As Range
For Each cell In Range("g2:j7")
    If cell.Interior.Color <> vbBlue Then cell.Interior.Color = vbBlue
Next cell
End Sub
[/vba]

Все гениальное просто и все простое гениально.
 
Ответить
Сообщение[vba]
Код
Sub TablColBlue()
Dim cell As Range
For Each cell In Range("g2:j7")
    If cell.Interior.Color <> vbBlue Then cell.Interior.Color = vbBlue
Next cell
End Sub
[/vba]
Автор - Nordheim
Дата добавления - 14.07.2017 в 08:13
Nordheim Дата: Пятница, 14.07.2017, 08:26 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
или так

[vba]
Код
Sub TablColBlue()
Dim cell As Range
For Each cell In Range("g2:j7")
    If cell.Interior.Color <> 16777215 Then cell.Interior.Color = vbBlue
Next cell
End Sub
[/vba]

Все гениальное просто и все простое гениально.
 
Ответить
Сообщениеили так

[vba]
Код
Sub TablColBlue()
Dim cell As Range
For Each cell In Range("g2:j7")
    If cell.Interior.Color <> 16777215 Then cell.Interior.Color = vbBlue
Next cell
End Sub
[/vba]
Автор - Nordheim
Дата добавления - 14.07.2017 в 08:26
Mexo Дата: Суббота, 15.07.2017, 00:21 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Кажется в коде нет ссылки на первую книгу. Первый вариант закрашивает все ячейки таблицы синим, второй - не закрашивает.
 
Ответить
СообщениеКажется в коде нет ссылки на первую книгу. Первый вариант закрашивает все ячейки таблицы синим, второй - не закрашивает.
Автор - Mexo
Дата добавления - 15.07.2017 в 00:21
Kuzmich Дата: Суббота, 15.07.2017, 22:54 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 715
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
Макрос во вторую книгу 1405087.xls
[vba]
Код
Sub Zalivka()
Dim i As Integer
Dim j As Integer
Dim Sheet_FirstBook As Worksheet
  Set Sheet_FirstBook = Workbooks("4165447.xls").Worksheets("Лист1")
    With Sheet_FirstBook
    Range("G2:J7").Interior.ColorIndex = xlColorIndexNone
      For i = 2 To 7
        For j = 7 To 10
          If .Cells(i, j - 5).Interior.ColorIndex = 4 Or .Cells(i, j - 5).Interior.ColorIndex = 6 Then
             Cells(i, j).Interior.ColorIndex = 5
          End If
        Next
      Next
    End With
End Sub
[/vba]
Первая книга 4165447.xls Обе книги должны быть открыты
 
Ответить
СообщениеМакрос во вторую книгу 1405087.xls
[vba]
Код
Sub Zalivka()
Dim i As Integer
Dim j As Integer
Dim Sheet_FirstBook As Worksheet
  Set Sheet_FirstBook = Workbooks("4165447.xls").Worksheets("Лист1")
    With Sheet_FirstBook
    Range("G2:J7").Interior.ColorIndex = xlColorIndexNone
      For i = 2 To 7
        For j = 7 To 10
          If .Cells(i, j - 5).Interior.ColorIndex = 4 Or .Cells(i, j - 5).Interior.ColorIndex = 6 Then
             Cells(i, j).Interior.ColorIndex = 5
          End If
        Next
      Next
    End With
End Sub
[/vba]
Первая книга 4165447.xls Обе книги должны быть открыты
Автор - Kuzmich
Дата добавления - 15.07.2017 в 22:54
Mexo Дата: Пятница, 21.07.2017, 22:38 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Спасибо!
 
Ответить
СообщениеСпасибо!
Автор - Mexo
Дата добавления - 21.07.2017 в 22:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заливка таблиц макросом (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!