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

Вход

Регистрация

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

 

= Мир MS Excel/Окрашивание листа при выполнении проверки ячеек - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Окрашивание листа при выполнении проверки ячеек (Макросы/Sub)
Окрашивание листа при выполнении проверки ячеек
kolesnikovfamily2012 Дата: Понедельник, 24.07.2023, 16:06 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

2019
Уважаемые, Гуру форума! Появилась задача, которую без вас не получается решить..
Мною был написан код для проверки заполнения ячеек листа и окрашивание его в зеленый цвет. Но сейчас появилось еще одно условие проверки с которым не получается справится. Листов в рабочем файле порядка 50 шт.
В появившейся таблице столбец № автоматически выдает п/н при внесении значения в соседнюю ячейку строки. Теперь необходимо:
1. Окрасить лист в зеленый цвет, если, помимо предшествующих условий, порядковому номеру соответствует разрешенный символ, иначе оставить цвет по дефолту
2. Окрасить лист в красный цвет, если порядковому номеру соответствует неразрешенный символ или символ с пробелом до и после
В приложенном примере на первом листе присутствует старый рабочий макрос. На последующих листах мои потуги которые не работают.
Прошу вашей помощи!
Рабочий код
[vba]
Код
Private Sub Worksheet_Deactivate()
If Len(Range("B2")) > 0 And Len(Range("F2")) > 0 And Len(Range("F3")) > 0 And Len(Range("F4")) > 0 And Len(Range("B7")) > 0 _
And Application.Count(Range("E7:E15")) = 1 Then
ThisWorkbook.Worksheets(1).Tab.Color = RGB(204, 255, 153)
Else
ThisWorkbook.Worksheets(1).Tab.Color = xlNone
End If
End Sub
[/vba]
Нерабочий код
[vba]
Код
Private Sub Worksheet_Deactivate()
If Len(Range("B2")) > 0 And Len(Range("F2")) > 0 And Len(Range("F3")) > 0 And Len(Range("F4")) > 0 And Len(Range("B7")) > 0 _
And Application.Count(Range("E7:E15")) = 1 And (Application.CountIf(Range("B12:B28"), "д") Or Application.CountIf(Range("B12:B28"), "Д") _
Or Application.CountIf(Range("B12:B28"), "м") Or Application.CountIf(Range("B12:B28"), "М") Or Application.CountIf(Range("B12:B28"), "в") _
Or Application.CountIf(Range("B12:B28"), "В") Or Application.CountIf(Range("B12:B28"), "п") Or Application.CountIf(Range("B12:B28"), "П")) Then
ThisWorkbook.Worksheets(2).Tab.Color = RGB(204, 255, 153)
ElseIf (Application.CountIf(Range("B12:B28"), "*д*") Or Application.CountIf(Range("B12:B28"), "*Д*") Or Application.CountIf(Range("B12:B28"), "*м*") _
Or Application.CountIf(Range("B12:B28"), "*М*") Or Application.CountIf(Range("B12:B28"), "*в*") Or Application.CountIf(Range("B12:B28"), "*В*") _
Or Application.CountIf(Range("B12:B28"), "*п*") Or Application.CountIf(Range("B12:B28"), "*П*")) Then
ThisWorkbook.Worksheets(2).Tab.Color = RGB(255, 0, 62)
Else
ThisWorkbook.Worksheets(2).Tab.Color = xlNone
End If
End Sub
[/vba]
К сообщению приложен файл: zadacha.xlsm (29.0 Kb)


Сообщение отредактировал kolesnikovfamily2012 - Понедельник, 24.07.2023, 16:14
 
Ответить
СообщениеУважаемые, Гуру форума! Появилась задача, которую без вас не получается решить..
Мною был написан код для проверки заполнения ячеек листа и окрашивание его в зеленый цвет. Но сейчас появилось еще одно условие проверки с которым не получается справится. Листов в рабочем файле порядка 50 шт.
В появившейся таблице столбец № автоматически выдает п/н при внесении значения в соседнюю ячейку строки. Теперь необходимо:
1. Окрасить лист в зеленый цвет, если, помимо предшествующих условий, порядковому номеру соответствует разрешенный символ, иначе оставить цвет по дефолту
2. Окрасить лист в красный цвет, если порядковому номеру соответствует неразрешенный символ или символ с пробелом до и после
В приложенном примере на первом листе присутствует старый рабочий макрос. На последующих листах мои потуги которые не работают.
Прошу вашей помощи!
Рабочий код
[vba]
Код
Private Sub Worksheet_Deactivate()
If Len(Range("B2")) > 0 And Len(Range("F2")) > 0 And Len(Range("F3")) > 0 And Len(Range("F4")) > 0 And Len(Range("B7")) > 0 _
And Application.Count(Range("E7:E15")) = 1 Then
ThisWorkbook.Worksheets(1).Tab.Color = RGB(204, 255, 153)
Else
ThisWorkbook.Worksheets(1).Tab.Color = xlNone
End If
End Sub
[/vba]
Нерабочий код
[vba]
Код
Private Sub Worksheet_Deactivate()
If Len(Range("B2")) > 0 And Len(Range("F2")) > 0 And Len(Range("F3")) > 0 And Len(Range("F4")) > 0 And Len(Range("B7")) > 0 _
And Application.Count(Range("E7:E15")) = 1 And (Application.CountIf(Range("B12:B28"), "д") Or Application.CountIf(Range("B12:B28"), "Д") _
Or Application.CountIf(Range("B12:B28"), "м") Or Application.CountIf(Range("B12:B28"), "М") Or Application.CountIf(Range("B12:B28"), "в") _
Or Application.CountIf(Range("B12:B28"), "В") Or Application.CountIf(Range("B12:B28"), "п") Or Application.CountIf(Range("B12:B28"), "П")) Then
ThisWorkbook.Worksheets(2).Tab.Color = RGB(204, 255, 153)
ElseIf (Application.CountIf(Range("B12:B28"), "*д*") Or Application.CountIf(Range("B12:B28"), "*Д*") Or Application.CountIf(Range("B12:B28"), "*м*") _
Or Application.CountIf(Range("B12:B28"), "*М*") Or Application.CountIf(Range("B12:B28"), "*в*") Or Application.CountIf(Range("B12:B28"), "*В*") _
Or Application.CountIf(Range("B12:B28"), "*п*") Or Application.CountIf(Range("B12:B28"), "*П*")) Then
ThisWorkbook.Worksheets(2).Tab.Color = RGB(255, 0, 62)
Else
ThisWorkbook.Worksheets(2).Tab.Color = xlNone
End If
End Sub
[/vba]
Автор - kolesnikovfamily2012
Дата добавления - 24.07.2023 в 16:06
WowGun Дата: Понедельник, 24.07.2023, 18:04 | Сообщение № 2
Группа: Проверенные
Ранг: Новичок
Сообщений: 45
Репутация: 19 ±
Замечаний: 0% ±

Excel 2016
Добрый день.
Не вдавался в подробности, но ... вы проверьте скобки повнимательнее. Дополнительное условие должно выполняться ЦЕЛИКОМ и значит объединено скобками.

УЧИТЕСЬ ... спрашивать.
 
Ответить
СообщениеДобрый день.
Не вдавался в подробности, но ... вы проверьте скобки повнимательнее. Дополнительное условие должно выполняться ЦЕЛИКОМ и значит объединено скобками.
Автор - WowGun
Дата добавления - 24.07.2023 в 18:04
Pelena Дата: Понедельник, 24.07.2023, 19:15 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
Цитата kolesnikovfamily2012, 24.07.2023 в 16:06, в сообщении № 1 ()
Листов в рабочем файле порядка 50 шт.

разместила макрос в модуле Эта книга, чтобы не размножать на 50 листов.
Посмотрите, так хотели?
[vba]
Код
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    With Sh
        If Len(.Range("B2")) > 0 And Len(.Range("F2")) > 0 And Len(.Range("F3")) > 0 And Len(.Range("F4")) > 0 And Len(.Range("B7")) > 0 _
           And Application.Count(.Range("E7:E15")) = 1 Then

            For i = 1 To Application.Max(.Range("A12:A28"))
                If .Cells(i + 11, 1) = i Then
                    If LCase(.Cells(i + 11, 2)) <> "д" And LCase(.Cells(i + 11, 2)) <> "м" And LCase(.Cells(i + 11, 2)) <> "в" _
                       And LCase(.Cells(i + 11, 2)) <> "п" Then .Tab.Color = RGB(255, 0, 62): Exit Sub
                Else
                    .Tab.Color = xlNone: Exit Sub
                End If
                
            Next i
            .Tab.Color = RGB(204, 255, 153)

        Else
            .Tab.Color = xlNone

        End If
    End With

End Sub
[/vba]
К сообщению приложен файл: 3375572.xlsm (29.9 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Цитата kolesnikovfamily2012, 24.07.2023 в 16:06, в сообщении № 1 ()
Листов в рабочем файле порядка 50 шт.

разместила макрос в модуле Эта книга, чтобы не размножать на 50 листов.
Посмотрите, так хотели?
[vba]
Код
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    With Sh
        If Len(.Range("B2")) > 0 And Len(.Range("F2")) > 0 And Len(.Range("F3")) > 0 And Len(.Range("F4")) > 0 And Len(.Range("B7")) > 0 _
           And Application.Count(.Range("E7:E15")) = 1 Then

            For i = 1 To Application.Max(.Range("A12:A28"))
                If .Cells(i + 11, 1) = i Then
                    If LCase(.Cells(i + 11, 2)) <> "д" And LCase(.Cells(i + 11, 2)) <> "м" And LCase(.Cells(i + 11, 2)) <> "в" _
                       And LCase(.Cells(i + 11, 2)) <> "п" Then .Tab.Color = RGB(255, 0, 62): Exit Sub
                Else
                    .Tab.Color = xlNone: Exit Sub
                End If
                
            Next i
            .Tab.Color = RGB(204, 255, 153)

        Else
            .Tab.Color = xlNone

        End If
    End With

End Sub
[/vba]
Автор - Pelena
Дата добавления - 24.07.2023 в 19:15
kolesnikovfamily2012 Дата: Вторник, 25.07.2023, 09:02 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

2019
Pelena, Добрый день! Вроде бы все работает как надо! Спасибо! Очень помогли и с кодом и с кучей листов....прям снимаю шляпу!)
 
Ответить
СообщениеPelena, Добрый день! Вроде бы все работает как надо! Спасибо! Очень помогли и с кодом и с кучей листов....прям снимаю шляпу!)
Автор - kolesnikovfamily2012
Дата добавления - 25.07.2023 в 09:02
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Окрашивание листа при выполнении проверки ячеек (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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