Заливка диапазона при изменении значений

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Заливка диапазона при изменении значений (Макросы/Sub)

Tavlar

Дата: Пятница, 29.07.2022, 15:00 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 63

Репутация: 0 ±

Замечаний: 0% ±

Excel 2019

Здравствуйте. Планируется создать файл, в котором будет база данных по сотрудникам, табель. Хочу закрашивать макросом ячейки в зависимости от содержимого.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "о" Then
Target.Interior.Color = vbRed
ElseIf Target.Value = "в" Then
Target.Interior.Color = vbGreen
ElseIf Target.Value = "д" Then
Target.Interior.Color = vbBlue
ElseIf Target.Value = "б" Then
Target.Interior.Color = vbYellow
End If
End Sub

[/vba]
Есть примитивный код, который закрашивает ячейку при изменении. Но при одновременном изменении нескольких ячеек выдает ошибку Type mismatch. Как можно изменить код, чтобы было возможно заливать сразу несколько ячеек, при изменении их значений. Или функцией Worksheet_Change это не возможно реализовать?

Ответить

Pelena

Дата: Пятница, 29.07.2022, 15:14 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Файл для проверки не приложили, поэтому проверьте сами
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
For each cell in Target
If cell.Value = "о" Then
cell.Interior.Color = vbRed
ElseIf cell.Value = "в" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value = "д" Then
cell.Interior.Color = vbBlue
ElseIf cell.Value = "б" Then
cell.Interior.Color = vbYellow
End If
Next cell
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

_Boroda_

Дата: Пятница, 29.07.2022, 15:21 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Я бы так сделал
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range
    On Error Resume Next
    For Each d_ In Intersect(Target, Range("A1:E9"))
        With d_
            Select Case .Value
                Case "о"
                    .Interior.Color = vbRed
                Case "в"
                    .Interior.Color = vbGreen
                Case "д"
                    .Interior.Color = vbBlue
                Case "б"
                    .Interior.Color = vbYellow
            End Select
        End With
    Next d_
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Nic70y

Дата: Пятница, 29.07.2022, 16:08 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 9005

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

так смешнее
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each u In Range(Target.Address)
        v = " о    1в  256б  257д65536"
        w = InStr(v, u.Value)
        On Error Resume Next
        u.Interior.Color = Trim(Mid(v, w + 1, 5)) * 255
    Next
End Sub

[/vba]как-то не очень смешно,
теперь да:
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each u In Range(Target.Address)
        v = "0о00001в00256б00257д65536ю"
        w = InStr(v, u.Value)
        On Error Resume Next
        u.Interior.Color = Mid(v, w + 1, 5) * 255
    Next
End Sub

[/vba]

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Пятница, 29.07.2022, 16:39

Ответить

Заливка диапазона при изменении значений (Макросы/Sub)

Страница 1 из 1
1