У трех руководителей в подчинении в общем 9 сотрудников , разбиение по руководителям приведено выше Необходимо написать макрос, который окрашивает ФИО и номер сотрудников в ячейках A5:B13 в цвета, соответсвущие их руковолителям. Кто нибудь может что нибудь посоветовать? пыталась сделать через условное форматирование но толком ничего не получилось. Файл прилагается.
У трех руководителей в подчинении в общем 9 сотрудников , разбиение по руководителям приведено выше Необходимо написать макрос, который окрашивает ФИО и номер сотрудников в ячейках A5:B13 в цвета, соответсвущие их руковолителям. Кто нибудь может что нибудь посоветовать? пыталась сделать через условное форматирование но толком ничего не получилось. Файл прилагается.Наташа73
у трех руководителей в подчинении в общем 9 сотрудников , разбиение по руководителям приведено выше Необходимо написать макрос, который окрашивает ФИО и номер сотрудников в ячейках A5:B13 в цвета, соответсвущие их руковолителям. Помогите пожалуйста [moder]Сцепил задвоенные темы. За безобразничанье - замечание и мин. бан 1 час согласно Правилам форума.
у трех руководителей в подчинении в общем 9 сотрудников , разбиение по руководителям приведено выше Необходимо написать макрос, который окрашивает ФИО и номер сотрудников в ячейках A5:B13 в цвета, соответсвущие их руковолителям. Помогите пожалуйста [moder]Сцепил задвоенные темы. За безобразничанье - замечание и мин. бан 1 час согласно Правилам форума.Наташа73
Sub sss() Dim arngHeads(1 To 3) As Range Set arngHeads(1) = Range("F2").Resize(3) Set arngHeads(2) = Range("G2").Resize(5) Set arngHeads(3) = Range("H2").Resize(4)
Dim c As Range, i As Integer, vRes On Error Resume Next For Each c In Range("B5:B13") vRes = Empty For i = 1 To 3 vRes = WorksheetFunction.Match(c.Value, arngHeads(i), 0) If Err.Number = 0 Then c.Interior.Color = arngHeads(i).Range("A1").Interior.Color Exit For Else Err.Clear End If Next i Next c End Sub
[/vba]
[vba]
Код
Sub sss() Dim arngHeads(1 To 3) As Range Set arngHeads(1) = Range("F2").Resize(3) Set arngHeads(2) = Range("G2").Resize(5) Set arngHeads(3) = Range("H2").Resize(4)
Dim c As Range, i As Integer, vRes On Error Resume Next For Each c In Range("B5:B13") vRes = Empty For i = 1 To 3 vRes = WorksheetFunction.Match(c.Value, arngHeads(i), 0) If Err.Number = 0 Then c.Interior.Color = arngHeads(i).Range("A1").Interior.Color Exit For Else Err.Clear End If Next i Next c End Sub