[發問] 關於資料驗證問題

j88141

輸入錯誤資料時未出現驗證訊息
查了office的說明 說

訊息只會在資料直接鍵入儲存格時出現。
訊息當使用者在儲存格中以複製或填入方式輸入資料時不會出現

想請問如果用VBA的話，是否可以在複製或填入方式時
出現驗證訊息

GBKEE

回復 1# j88141
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Selection.Copy
   
4.     With Range("D1")
   
5.         .PasteSpecial xlPasteValues  '僅複製值
   
6.         .Select
   
7.         Application.SendKeys "{F2}~", True     '按鍵 F2:插入 ,~ :Enter
   
8.     End With
   
9. End Sub

複製代碼

j88141

回復 2# GBKEE


   我自己做了一個小例子，
可是不知道如何把GBKEE版主的程式碼運用上去
活頁簿.rar (15.08 KB)

下載次數: 8

2014-8-28 15:46

謝謝GBKEE版主幫忙解惑

GBKEE

回復 3# j88141
不知是2007檔案在2003環境中轉檔,沒有見資料驗證的儲存格
修改一下你的程式

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim Rng(1 To 2) As Range, E As Range
   
3.     Set Rng(1) = [A1:C2]   '擴充到C2試試  '可修改為大課表的E列 到 P列
   
4.     Application.EnableEvents = False
   
5.     If Not Intersect(Target, Rng(1)) Is Nothing Then  'Target, Rng(1) 儲存格範圍有交集到
   
6.         For Each E In Rng(1).Rows(1).Cells            '姓名列
   
7.             Set Rng(2) = Range("C11:C14").Find(E, LookAt:=xlWhole, MatchCase:=True)
   
8.             With E.Offset(1)
   
9.                 If Not Rng(2) Is Nothing Then .Value = Rng(2).Offset(0, 1).Value Else .Value = ""
   
10.             End With
    
11.         Next
    
12.     End If
    
13.     Application.EnableEvents = True
    
14. End Sub

複製代碼

j88141

回復 4# GBKEE


回復    GBKEE大
你的程式碼改完後，我發現A2:C2 會變成無法單獨輸入(想要都可以輸入)
等於是被A1:C1綁架(要A1有輸入，A2才有)

這次應該有資料驗證的儲存格了

下載 (40.27 KB)

2014-8-28 21:48

活頁簿.rar (16.32 KB)

下載次數: 5

2014-8-28 21:52

Hsieh

回復 5# j88141
驗證公式改一下
=COUNTIF($G$2:$H$5,A$2)>0

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Intersect(Target, [A1:C1]) Is Nothing Then Exit Sub '輸入人名的範圍設定在A1:C1
   
3. If Target.Count > 1 Then MsgBox "只能改變一格": Exit Sub
   
4.         Set Rng = Range("C:C").Find(Target, LookAt:=xlWhole, MatchCase:=True)
   
5.         With Target.Offset(1)
   
6.             If Not Rng Is Nothing Then .Value = Rng.Offset(0, 1).Value: Application.SendKeys "{F2}~"
   
7.             DoEvents
   
8.            If .Validation.Value = False Then .Value = ""
   
9.         End With
   
10. End Sub

複製代碼

活頁簿.rar (14.43 KB)

下載次數: 10

2014-8-28 22:21

j88141

謝謝各位解答
成功了
~