Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Помогите реализовать алгоритм: ввод данных в пустые ячейки и запрет изменения заполненных.
 
#1
14.12.2012 19:07:59
Здравствуйте! Мне нужен макрос на VBA, чтобы в определенные ячейки (С20:С90), первоначально пустые, можно было вводить одну из цифр от 1 до 5. Но после ввода изменить введённую цифру нельзя. И если введены другие цифры или буквы, или знаки, чтобы выскакивала msgbox о неправильной попытке ввода.  
 
(Чего-то туплю на простой функции If-Else, If-Case)  
 
Спасибо всем откликнувшимся.
 
 
 
#2
14.12.2012 19:12:39
комбинируем:  
1. данные - проверка данных - целое число - между 1 и 5  
2. макрос на событие листа Change  
3. свойство ячейки Locked  
4. метод листа Protect
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#3
14.12.2012 19:18:20
а можно вместо locked сделать копированием-вставкой?  
Ну, если ячейка уэе заполнена, копируем её значение в буфер, а при вводе в неё другого числа - вытаскиваем скопированное прежнее число и вставляем на место.
 
 
 
#4
14.12.2012 19:23:45
зачем?  
если не хочется возиться с защитой - почитайте про Undo.  
только не забудьте отключать-включать обработку событий (Application.EnableEvents).  
кстати, для вашего варианта такое отключение-включение тоже нужно.  
иначе событие Change будет возникать и обрабатываться бесконечно.  
или до достижения предела вложенности вызовов функций?.. ну, в общем-то неважно.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#5
14.12.2012 20:43:13
В модуль листа  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Range("C20:C90"), Range(Target.Address)) Is Nothing Then Exit Sub  
Application.EnableEvents = False  
If Target.Value < 1 Or Target.Value > 5 Then MsgBox ("íåëüçÿ!"): Range(Target.Address) = Empty: Range("B1").Select  
Application.EnableEvents = True  
End Sub  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
If Intersect(Range("C20:C90"), Selection) Is Nothing Then Exit Sub  
   If Intersect(Range("C20:C90"), Selection).Cells.Count > 1 Then MsgBox ("íåëüçÿ!"): Range("B1").Select: Exit Sub  
   If ActiveCell <> "" Then MsgBox ("íåëüçÿ!"): Range("B1").Select  
End Sub  
 
попробуте.
 
 
 
#6
14.12.2012 20:51:03
В MsgBox напишите какое ни будь сообщение, или вообще без предупреждений:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Range("C20:C90"), Range(Target.Address)) Is Nothing Then Exit Sub  
Application.EnableEvents = False  
If Target.Value < 1 Or Target.Value > 5 Then Range(Target.Address) = Empty: Target.Select  
Application.EnableEvents = True  
End Sub  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
If Intersect(Range("C20:C90"), Selection) Is Nothing Then Exit Sub  
   If Intersect(Range("C20:C90"), Selection).Cells.Count > 1 Then Range("B1").Select: Exit Sub  
   If ActiveCell <> "" Then MsgBox ("íåëüçÿ!"): Range("B1").Select  
End Sub
 
 
 
#7
14.12.2012 20:56:50
Михаил, не забываем при копировании из редактора следить за раскладкой клавиатуры: должна быть RU :-)
 
 
 
#8
14.12.2012 21:15:32
Юрий, я знаю, но... забыл и сразу не увидел... а потом - поздно :)
 
 
 
#9
14.12.2012 21:19:56
Спасибо всем!  
Запрет изменения в ячейке сделал так:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target <> vValue Then  
   Target.Value = vValue  
   End If  
End Sub  
 
А проверку ввода значений (от 1 до 5) не делал, не понадобилось по ходу решения моеё задачи.  
 
СПАСИБО!
 
 
 
#10
14.12.2012 21:37:39
{quote}{login=Михаил С.}{date=14.12.2012 09:15}{thema=}{post}Юрий, я знаю, но... {/post}{/quote}А я и не сомневался ))
 
 
 
#11
14.12.2012 21:57:50
Рано обрадовался:  
Не работает условие проверки пустой ячейки  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
If IsEmpty(Target) = True Then Exit Sub  
   If Target <> vValue Then  
   Target.Value = vValue  
   'Target.Interior.Color = vbWhite  
   End If  
End Sub  
 
Надо, чтобы при вводе в пустую ячейку вводимое число осталось бы в ячейке
 
 
 
#12
17.12.2012 00:26:48
Попробуйте вот так. Правда изменить значение ячейки можно различными способами, данный пример не защищает от протяжки, "Формат по образцу" и наверняка чего-то еще.  
 
Public vValue  
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)  
Cancel = True  
End Sub  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
If vValue = "" Then Exit Sub  
If Target.Count > 1 Then ActiveCell.Select: Exit Sub  
If Target <> vValue Then  
Target.Value = vValue  
'Target.Interior.Color = vbWhite  
End If  
End Sub  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
On Error GoTo Cancel 'при выделении всего листа ошибка Overflow  
If Target.Count > 1 Then ActiveCell.Select: Exit Sub  
If Target.Value <> "" Then Application.CutCopyMode = False  
vValue = Target.Value: Exit Sub  
Cancel:  
[a1].Select
End Sub
 
 
 
#13
17.12.2012 01:59:12
Или попробуйте вот это под себя сделать.  
Макрос при изменении значений в столбце N возвращает предыдущие значения.  
Я его немного для другого писал, поудалял малёк из него, но и лишнее осталось.  
Изменяйте под себя и смело чекрыжте.  
Удачи!
 
 
 
#14
19.12.2012 11:52:01
iba2004, спасибо за помощь! Решил проблему вот так (для столбца "С"):  
 
Option Explicit  
Dim vValue  
______________________________________________  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If (Target.Column = 3) Then  
       If vValue = "" Then  
           Exit Sub  
       Else  
           If Target <> vValue Then  
               Target.Value = vValue  
           End If  
       End If  
   End If  
End Sub  
___________________________________________  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
   If Target.Count = 1 Then vValue = Target  
End Sub  
 
Все макросы - в модуле листа.
 
 
 
Страницы: 1
Наверх