Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

Запрет на вставку не оригинального значения ячейки

Автор Борис_1, 12.02.2014, 13:59

« назад - далее »

Борис_1

Уважаемые форумчане! Нужна ваша помощь. К сожалению решение проблемы не нашел на форумах (может плохо искал). Имеется файл Excel с обозначениями деталей производителя (первый столбец) и соответствующий им столбец с внутренним обозначением (второй столбец). Имеется еще столбец с некоторыми описаниями и характеристиками. Стоит задача: из других источников (формат excel) вручную копируется в буфер обмена содержимое ячейки с обозначением детали и вставляется в первый или во второй столбец перврого файла с проверкой оригинальности обозначения. Если содержимое вставляется в первый столбец, то необходимо проверить оригинальность обозначения в первом столбце и при совпадении должен быть запрет на вставку. Соответствующая проверка должна быть и по второму столбцу в случае вставки в ячейку второго столбца. Крайне слаб в VB. Пните в сторону примера решения аналогичной проблемы. Буду благодарен.

kuklp

Цитата: Борис_1 от 12.02.2014, 13:59Имеется файл Excel...
Не верю. Читаем Правила, выкладываем пример. Иначе тему удалю.
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Борис_1

Извиняюсь за нарушение правила форума. Выкладываю пример файла куда необходимо вставлять значения в ячейки столбца "B" и "C".

kuklp

В модуль листа:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Rows.Count > 1 Then Exit Sub
    If Intersect(Target, UsedRange, [b:c]) Is Nothing Then Exit Sub
    If Application.CountIf(Intersect(UsedRange, Columns(2)), Target) > 1 Or _
       Application.CountIf(Intersect(UsedRange, Columns(3)), Target) > 1 Then
        Application.EnableEvents = 0
        Cells(Target.Row, 2).Resize(, 3).ClearContents
        MsgBox "Double!"
        Application.EnableEvents = -1
    End If
End Sub
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Борис_1

Огромное спасибо KuklP! Все работает прекрасно! Не сочтите за наглость, но хотелось бы немного расширить предыдущую задачу: выделяем и копируем в буфер обмена одновременно две ячейки одной строки (например B2 и C2) и затем курсор устанавливаем на свободную строку (в моем примере на ячейку B4) и вставляем информацию из буфера обмена. При этом должна проходить проверка на неидентичность информации по столбцам. Макрос любезно предоставленный KuklP выдает ошибку приведенная во вложении. Как дополнить упомянутый макрос?

kuklp

Вы писали:
Цитата: Борис_1 от 12.02.2014, 13:59...вручную копируется в буфер обмена содержимое ячейки с обозначением детали и вставляется в первый или во второй столбец ...
Мой макрос и написан под эти условия. А на скрине вставляется в первый И во второй столбец. Разницу чувствуете? ;)
Попробуйте так:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Rows.Count > 1 Then Exit Sub
    If Intersect(Target, UsedRange, [b:c]) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    If Target.Count > 1 Then
        If Application.CountIf(Intersect(UsedRange, Columns(2)), Target(1)) > 1 Or _
           Application.CountIf(Intersect(UsedRange, Columns(3)), Target)(2) > 1 Then _
           GoSub doubles
    Else
        If Application.CountIf(Intersect(UsedRange, Columns(2)), Target(1)) > 1 Then _
           GoSub doubles
    End If
    Application.EnableEvents = -1
    Exit Sub
doubles:
    Cells(Target.Row, 2).Resize(, 3).ClearContents
    MsgBox "Double!"
    Return
End Sub

P.S. и мой Вам совет, не у всех есть 7z, лучше пакуйте в rar. Или не пакуйте. Форум допускает формат gif во вложениях.
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Борис_1

Спасибо за ответ и наставления KuklP! Макрос работает. Единственный недостаток: при копировании одной ячейки из столбца "С" и вставки в свободную ячейку этого же столбца не происходит проверки на неидентичность. Это я пишу для информации. Логику KuklP я понял и попробую доработать макрос самостоятельно.

kuklp

Ну и зачем Вы прикрепляли файл xlsx? В таком формате не может быть макросов. Хотите, чтоб было с макросами, выкладывайте в xls.
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Rows.Count > 1 Then Exit Sub
    If Intersect(Target, UsedRange, [b:c]) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    If Target.Count > 1 Then
        If Application.CountIf(Intersect(UsedRange, Columns(2)), Target(1)) > 1 Or _
           Application.CountIf(Intersect(UsedRange, Columns(3)), Target)(2) > 1 Then _
           GoSub doubles
    Else
        If Application.CountIf(Intersect(UsedRange, Columns(Target.Column)), Target) > 1 Then _
           GoSub doubles
    End If
    Application.EnableEvents = -1
    Exit Sub
doubles:
    Cells(Target.Row, 2).Resize(, 3).ClearContents
    MsgBox "Double!"
    Return
End Sub
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Борис_1

Спасибо KuklP! Все прекрасно работает! Вот за что я люблю наш народ: обратишся с просьбой и с начала убедят тебя что ты недоучка, затем буду убеждать, что этого тебе не надо и зате помогут тебе по полной программе! Еще раз мои благодарности и надеюсь это будет интересно не только мне. Отдаю макрос на тестирование народу, т.е. моим молодым коллегам по работе.

RAN


ber_ya

Доброе  время суток! А как можно выполнить обратную задачу  - запрет на ввод любых значений, кроме заданного для этого столбца?