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

Вход

Регистрация

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

 

= Мир MS Excel/Заливка диапазона при изменении значений - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заливка диапазона при изменении значений (Макросы/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 это не возможно реализовать?
 
Ответить
СообщениеЗдравствуйте. Планируется создать файл, в котором будет база данных по сотрудникам, табель. Хочу закрашивать макросом ячейки в зависимости от содержимого.
[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 это не возможно реализовать?

Автор - Tavlar
Дата добавления - 29.07.2022 в 15:00
Pelena Дата: Пятница, 29.07.2022, 15:14 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19162
Репутация: 4412 ±
Замечаний: ±

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
 
Ответить
СообщениеЗдравствуйте.
Файл для проверки не приложили, поэтому проверьте сами
[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]

Автор - Pelena
Дата добавления - 29.07.2022 в 15:14
_Boroda_ Дата: Пятница, 29.07.2022, 15:21 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

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
 
Ответить
СообщениеЯ бы так сделал
[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_
Дата добавления - 29.07.2022 в 15:21
Nic70y Дата: Пятница, 29.07.2022, 16:08 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 8705
Репутация: 2260 ±
Замечаний: 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
 
Ответить
Сообщениетак смешнее
[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]

Автор - Nic70y
Дата добавления - 29.07.2022 в 16:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заливка диапазона при изменении значений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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