Страницы: 1
RSS
Ввод в ячейку данных только кратных заданному числу
 
Добрый день. Подскажите, пожалуйста, можно ли реализовать такую функцию. Нужно, чтобы при вводе числа в ячейку можно было ввести только число кратное заданному. Например, задаю число 6, и теперь в ячейку ввести можно только 6, 12, 18 и так далее, при вводе других чисел либо какое-то уведомление об ошибке, либо просто ничего не происходит.
Вроде что-то такое я нашёл в сети, но там это работает как обычная функция и в соседней ячейке, а мне нужно чтобы данные обрабатывались именно в той ячейке, в которую я ввожу число.
 
В модуль листа.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Target.Value Mod 6 <> 0 Then MsgBox "Ээээ....", vbCritical
    End If
End Sub
 
МатросНаЗебре,
мне кажется 6 - все лишь пример
 
Цитата
написал:
В модуль листа.
Код
    [URL=#]?[/URL]       1  2  3  4  5      Private   Sub   Worksheet_Change(  ByVal   Target   As   Range)          If   Target.Cells.Count = 1   Then              If   Target.Value   Mod   6 <> 0   Then   MsgBox   "Ээээ...."  , vbCritical          End   If    End   Sub   
 
Спасибо. Два момента. Ошибка выскакивает, но число все равно вводится после нажатия ок. И как этот код применить к конкретной ячейке? точнее к столбцу?
Изменено: Евгений - 18.08.2022 10:35:38
 
Цитата
написал:
МатросНаЗебре,
мне кажется 6 - все лишь пример
да, но я так понимаю в код можно любое число подставить, мне так сойдет, у меня на лист будет какое-то одно конкретное число
Изменено: Евгений - 18.08.2022 10:33:05
 
стандартная проверка ввода данных
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Удаляет ошибочное значение.
Ограничение по столбцу.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Target.Column = 2 Then
            If Not IsEmpty(Target.Value) Then
                If Target.Value Mod 6 <> 0 Then
                    MsgBox "Ээээ....", vbCritical
                    Application.EnableEvents = False
                    Target.Value = Empty
                    Application.EnableEvents = True
                End If
            End If
        End If
    End If
End Sub
 
Спасибо всем огромное! Работает и код и через проверку ввода.
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B5:B10")) Is Nothing Then
            If Not IsEmpty(Target.Value) Then
                If Target.Value Mod 6 <> 0 Then
                    MsgBox "Ээээ....", vbCritical
                    Application.EnableEvents = False
                    Target.Value = Empty
                    Application.EnableEvents = True
                End If
            End If
        End If
    End If
End Sub
По просьбе ТС добавлена проверка принадлежности к диапазону.
 
Спасибо! То, что нужно
Страницы: 1
Наверх