Уважаемые, Гуру форума! Появилась задача, которую без вас не получается решить.. Мною был написан код для проверки заполнения ячеек листа и окрашивание его в зеленый цвет. Но сейчас появилось еще одно условие проверки с которым не получается справится. Листов в рабочем файле порядка 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]
Уважаемые, Гуру форума! Появилась задача, которую без вас не получается решить.. Мною был написан код для проверки заполнения ячеек листа и окрашивание его в зеленый цвет. Но сейчас появилось еще одно условие проверки с которым не получается справится. Листов в рабочем файле порядка 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
Добрый день. Не вдавался в подробности, но ... вы проверьте скобки повнимательнее. Дополнительное условие должно выполняться ЦЕЛИКОМ и значит объединено скобками.
Добрый день. Не вдавался в подробности, но ... вы проверьте скобки повнимательнее. Дополнительное условие должно выполняться ЦЕЛИКОМ и значит объединено скобками.WowGun
разместила макрос в модуле Эта книга, чтобы не размножать на 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
разместила макрос в модуле Эта книга, чтобы не размножать на 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