j88141

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2014-8-27 22:35 | 只看該作者

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

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

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

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

樓主熱帖

j88141

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

7^#

發表於 2014-9-1 21:17 | 只看該作者

謝謝各位解答
成功了
~

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 276
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2014-8-28 22:19 | 只看該作者

本帖最後由 Hsieh 於 2014-8-28 22:21 編輯

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

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

複製代碼

活頁簿.rar (14.43 KB)

學海無涯_不恥下問

TOP

j88141

中學生 Rank: 2

帖子: 46
主題: 10
精華: 0
積分: 88
點名: 0
作業系統: WIN10
軟體版本: excel2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2014-1-27
最後登錄: 2018-3-30

5^#

發表於 2014-8-28 21:54 | 只看該作者

回復 4# GBKEE

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

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

活頁簿.rar (16.32 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2014-8-28 20:15 | 只看該作者

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

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