Добрый день. Подскажите пожалуйста по следующему вопросу. У меня есть макрос который по нажатию на кнопку добавляет строку в заданном диапазоне. Как с помощью VBA сделать ограничение на добавление повторяющихся значений в диапазоне.
Условный пример во вложении. В столбце D унникальные значения. -Макрос должен работать в диапазоне ячеек D2:D14 -При попытке добавления значения, которое уже есть в данном диапазоне - должно выскочить ругательное сообщение какое-нибудь -и потом удалить это введеное значение
не нужно вводить значение, чтобы потом удалять можно сразу проверить наличие такого значения, написать что ввод дубликатов запрещен и ничего не добавлять
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Ігор Гончаренко, ну это понятно...но для омновной задачи не подходит т.к. у меня макрос который добавляет строки по нажатию кнопки и мне необходимо данную проверку на уровне vba сделать
Эта задача уже много лет назад была решена Н. Павловым. Вот вариант на VBA, гугл выдал по такому же простому запросу, только дописал "vba"(excel vba запрет ввода повторяющихся данных)
а после нажатия кнопки случайно не vba добавляет строки? вот на этом уровне и внесите поправки в макрос (а вообще зачем было писать макрос, который добавляет непотребную ерунду в данные? зачем вам понадобился такой бестолковый макрос, который теперь нужно исправлять другим макросом) решили подкинуть кода на вентилятор?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Уважаемые знатоки, Хочу немного развить тему. Оба варианта, предложенные пользователем DANIKOLA (код VBA и проверка значений от Н.Павлова), работают только в том случае, если вводить данные в ячейки вручную. Если же вводить с помощью UserForm, то Excel игнорирует эти условия. Как можно решить эту задачу?
написал: Если же вводить с помощью UserForm, то Excel игнорирует эти условия.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("B:D")) Is Nothing Then
Exit Sub
Else
With Target
Set Rng = Range(Cells(2, .Column), .Offset(-1))
If IsError(Application.Match(.Value, Rng, 0)) Then
Exit Sub
Else
MsgBox "Значение уже существует и будет уничтожено"
Target = Empty
End If
End With
End If
End If
testuser спасибо за желание помочь, но ваш код, к сожалению, не работает. Уже при первом же вводе в пустой лист код выдает сообщение, что значение уже существует. Пытался как то преобразовать код, но безрезультатно.
БМВ. Я понимаю, что лучше не допускать повтора данных, чтоб потом не делать исправления, но идея такова: Данные через Форму вводит один из пользователей раз в сутки. При чем пользователи не знают, вводились ли уже сегодня данные или нет, т.к. не видят страницы Excel. Поэтому выдается сообщение что данные СЕГОДНЯ уже введены и эта строка не сохраняется.
Micha Julis, небольшая модернизация и все работает )
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("B:D")) Is Nothing Then
Exit Sub
Else
With Target
If .Row = 1 Or .Row = 2 Then Exit Sub
Set Rng = Range(Cells(2, .Column), .Offset(-1))
If IsError(Application.Match(.Value, Rng, 0)) Then
Exit Sub
Else
MsgBox "Error!!!"
Target = Empty
End If
End With
End If
End Sub
Вам в #5 подсказали, что нужно делать, а в #7 продублировали... Для чего продолжать пытаться применить макрос, предназначенный для других задач?
Код
Private Sub CommandButton_Save_Click()
' If Me.ComboBox_Name = "" Then MsgBox "Please enter name", vbCritical, "Error": Exit Sub
' If Me.ComboBox6 = "" Then MsgBox "Please enter all data", vbCritical, "Error": Exit Sub
' If Me.ComboBox7 = "" Then MsgBox "Please enter all data", vbCritical, "Error": Exit Sub
Dim cell As Range: Set cell = [a65000].End(xlUp).Offset(1)
If Application.CountIf(Columns(1), Me.TextBox_Date) > 0 Then MsgBox "isn't correct", vbCritical, "Error": Exit Sub
cell(1, 1) = Me.TextBox_Date
cell(1, 2) = Me.ComboBox_Name
cell(1, 3) = Me.ComboBox6
cell(1, 4) = Me.ComboBox7
cell(1, 5) = Me.ComboBox9
End Sub
Public FrmSv As Boolean
Private Sub CommandButton_Save_Click()
Dim cell As Range: Set cell = [a65000].End(xlUp).Offset(1)
Set Rng = Range(Cells(2, 1), cell(1, 1).Offset(-1))
If IsError(Application.Match(Me.TextBox_Date, Rng, 0)) Then
FrmSv = True
cell(1, 1) = Me.TextBox_Date:
'If cell(1, 1).CountIf(A2, RA) <= 1 Then MsgBox "isn't correct", vbCritical, "Error": Exit Sub
cell(1, 2) = Me.ComboBox_Name:
cell(1, 3) = Me.ComboBox6:
cell(1, 4) = Me.ComboBox7:
cell(1, 5) = Me.ComboBox9:
FrmSv = False
Else
MsgBox "Error!!!"
Exit Sub
End If
' If Me.ComboBox_Name = "" Then MsgBox "Please enter name", vbCritical, "Error": Exit Sub
' If Me.ComboBox6 = "" Then MsgBox "Please enter all data", vbCritical, "Error": Exit Sub
' If Me.ComboBox7 = "" Then MsgBox "Please enter all data", vbCritical, "Error": Exit Sub
End Sub
В модуле листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Static RmvBl As Boolean
If RmvBl Then RmvBl = False: Exit Sub
If UserForm1.FrmSv Then Exit Sub
If Intersect(Target, Columns("A:A")) Is Nothing Then
Exit Sub
Else
With Target
If .Row = 1 Or .Row = 2 Or IsEmpty(Target) Then Exit Sub
Set Rng = Range(Cells(2, .Column), .Offset(-1))
If IsError(Application.Match(.Value, Rng, 0)) Then
Exit Sub
Else
MsgBox "Error!!!"
RmvBl = True
Target.Columns("A:E") = Empty
End If
End With
End If
End Sub