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

Вход

Регистрация

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

 

= Мир MS Excel/Закрасить ячейки по условию VBA - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Закрасить ячейки по условию VBA (Макросы/Sub)
Закрасить ячейки по условию VBA
Dendibar Дата: Понедельник, 21.03.2016, 19:04 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Добрый день!

Подскажите пожалуйста, как можно с помощью макроса закрасить ячейки на пересечении 2 значений (одно по строке, другое по столбцу)?
С помощью условного форматирования знаю как - но мне нужно сделать это макросом.
Пример прилагаю - там описаны условия и как должно выглядеть на выходе (цвет не принципиален - мне бы понять принцип).
Заранее благодарю за помощь!
К сообщению приложен файл: 3012255.xlsx(36Kb)
 
Ответить
СообщениеДобрый день!

Подскажите пожалуйста, как можно с помощью макроса закрасить ячейки на пересечении 2 значений (одно по строке, другое по столбцу)?
С помощью условного форматирования знаю как - но мне нужно сделать это макросом.
Пример прилагаю - там описаны условия и как должно выглядеть на выходе (цвет не принципиален - мне бы понять принцип).
Заранее благодарю за помощь!

Автор - Dendibar
Дата добавления - 21.03.2016 в 19:04
Karataev Дата: Понедельник, 21.03.2016, 19:18 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 227 ±
Замечаний: 0% ±

Excel
[vba]
Код
Sub Закрасить()

    Dim i As Long, j As Long, strSearchText As String
    
    Application.ScreenUpdating = False
    
    Range("B2:D7").Interior.ColorIndex = xlColorIndexNone
    
    For i = 2 To 7
        Select Case Cells(i, 1).Value
            Case "Ф1"
                strSearchText = "Значение 1"
            Case "Ф2"
                strSearchText = "Значение 2"
        End Select
        For j = 2 To 4
            If Cells(1, j).Value = strSearchText Then
                Cells(i, j).Interior.ColorIndex = 6
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation

End Sub
[/vba]


 
Ответить
Сообщение[vba]
Код
Sub Закрасить()

    Dim i As Long, j As Long, strSearchText As String
    
    Application.ScreenUpdating = False
    
    Range("B2:D7").Interior.ColorIndex = xlColorIndexNone
    
    For i = 2 To 7
        Select Case Cells(i, 1).Value
            Case "Ф1"
                strSearchText = "Значение 1"
            Case "Ф2"
                strSearchText = "Значение 2"
        End Select
        For j = 2 To 4
            If Cells(1, j).Value = strSearchText Then
                Cells(i, j).Interior.ColorIndex = 6
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation

End Sub
[/vba]

Автор - Karataev
Дата добавления - 21.03.2016 в 19:18
Dendibar Дата: Понедельник, 21.03.2016, 19:41 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Karataev, большое спасибо!

Если меняю диапазоны:
[vba]
Код
С For i = 2 To 7 на For i = 1 To 50
[/vba]
и
[vba]
Код
С For j = 2 To 7 на For j = 1 To 50
[/vba]
почему-то полностью закрашивает весь 2ой столбец и всю первую строку не зависимо от того, выполняется условие, или нет.
Подскажите, в каком месте криво делаю?
[moder]Оформляйте коды тегами (кнопка #)[/moder]


Сообщение отредактировал Dendibar - Понедельник, 21.03.2016, 22:52
 
Ответить
СообщениеKarataev, большое спасибо!

Если меняю диапазоны:
[vba]
Код
С For i = 2 To 7 на For i = 1 To 50
[/vba]
и
[vba]
Код
С For j = 2 To 7 на For j = 1 To 50
[/vba]
почему-то полностью закрашивает весь 2ой столбец и всю первую строку не зависимо от того, выполняется условие, или нет.
Подскажите, в каком месте криво делаю?
[moder]Оформляйте коды тегами (кнопка #)[/moder]

Автор - Dendibar
Дата добавления - 21.03.2016 в 19:41
Karataev Дата: Понедельник, 21.03.2016, 19:58 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 227 ±
Замечаний: 0% ±

Excel
Обратите внимание, что у меня макрос работает, начиная со 2-ой строки и со 2-го столбца, т.к. в первом столбце и первой строке находятся заголовки.


 
Ответить
СообщениеОбратите внимание, что у меня макрос работает, начиная со 2-ой строки и со 2-го столбца, т.к. в первом столбце и первой строке находятся заголовки.

Автор - Karataev
Дата добавления - 21.03.2016 в 19:58
Udik Дата: Понедельник, 21.03.2016, 20:00 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
так можно
[vba]
Код

Dim lName As String
Dim lastRow As Integer

Public Sub test()
lName = "Лист1"
lastRow = 7
Call paint("Ф1", 2, VBA.RGB(255, 0, 0)) '2-й столбец  и свой цвет
Call paint("Ф2", 3, VBA.RGB(0, 255, 0)) '3-й столбец и свой цвет

End Sub

Public Sub paint(str1 As String, numCol As Integer, cellColor As Long)
Dim c1 As Range

With Worksheets(lName)
For Each c1 In .Range(.Cells(2, numCol), .Cells(lastRow, numCol))
If c1.Offset(0, 1 - numCol).Text = str1 Then c1.Interior.Color = cellColor
Next
End With
End Function

[/vba]
К сообщению приложен файл: 0t.xlsm(16Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Понедельник, 21.03.2016, 20:02
 
Ответить
Сообщениетак можно
[vba]
Код

Dim lName As String
Dim lastRow As Integer

Public Sub test()
lName = "Лист1"
lastRow = 7
Call paint("Ф1", 2, VBA.RGB(255, 0, 0)) '2-й столбец  и свой цвет
Call paint("Ф2", 3, VBA.RGB(0, 255, 0)) '3-й столбец и свой цвет

End Sub

Public Sub paint(str1 As String, numCol As Integer, cellColor As Long)
Dim c1 As Range

With Worksheets(lName)
For Each c1 In .Range(.Cells(2, numCol), .Cells(lastRow, numCol))
If c1.Offset(0, 1 - numCol).Text = str1 Then c1.Interior.Color = cellColor
Next
End With
End Function

[/vba]

Автор - Udik
Дата добавления - 21.03.2016 в 20:00
Wasilich Дата: Понедельник, 21.03.2016, 20:08 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 877
Репутация: 222 ±
Замечаний: 0% ±

2003
Согласно примера
For i = 2 To 7 - Цикл прохода по строкам со 2-й по 7-ю
For j = 2 To 4 - Цикл прохода по столбцам со 2-го по 4-й внутри цикла по строкам.
Вы поставили For i = 1 To 50 и For j = 1 To 50
У вас там что 50 строк и 50 столбцов? Покажите, что вы там намудрили, автор макроса тоже не экстрасенс.
 
Ответить
СообщениеСогласно примера
For i = 2 To 7 - Цикл прохода по строкам со 2-й по 7-ю
For j = 2 To 4 - Цикл прохода по столбцам со 2-го по 4-й внутри цикла по строкам.
Вы поставили For i = 1 To 50 и For j = 1 To 50
У вас там что 50 строк и 50 столбцов? Покажите, что вы там намудрили, автор макроса тоже не экстрасенс.

Автор - Wasilich
Дата добавления - 21.03.2016 в 20:08
al-Ex Дата: Понедельник, 21.03.2016, 20:14 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 149
Репутация: 53 ±
Замечаний: 0% ±

Excel 2010
Если меняю диапазоны
Вот, в любом диапазоне работает:
[moder] al-Ex, хорош уже шалить. Вы, надеюсь, поняли, о чем я.[/moder][p.s.]* исправился ), виноват.
К сообщению приложен файл: krsk.xlsm(16Kb)


Сообщение отредактировал al-Ex - Вторник, 22.03.2016, 01:42
 
Ответить
Сообщение
Если меняю диапазоны
Вот, в любом диапазоне работает:
[moder] al-Ex, хорош уже шалить. Вы, надеюсь, поняли, о чем я.[/moder][p.s.]* исправился ), виноват.

Автор - al-Ex
Дата добавления - 21.03.2016 в 20:14
StoTisteg Дата: Понедельник, 21.03.2016, 20:54 | Сообщение № 8
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
al-Ex, а если оно ещё и начинается не с начала? ;)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщениеal-Ex, а если оно ещё и начинается не с начала? ;)

Автор - StoTisteg
Дата добавления - 21.03.2016 в 20:54
Dendibar Дата: Вторник, 22.03.2016, 00:01 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Спасибо Всем огромное за помощь и подробные объяснения - очень выручили!
Все варианты подошли. Отедельное спасибо al-Ex - самый удобный вариант, так как не привязан к конкретному диапазону)
 
Ответить
СообщениеСпасибо Всем огромное за помощь и подробные объяснения - очень выручили!
Все варианты подошли. Отедельное спасибо al-Ex - самый удобный вариант, так как не привязан к конкретному диапазону)

Автор - Dendibar
Дата добавления - 22.03.2016 в 00:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Закрасить ячейки по условию VBA (Макросы/Sub)
Страница 1 из 11
Поиск:

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