[發問] 當B欄號碼與預設規則不同時，如何彈出視窗提醒？

RCRG

B欄與預設不同提醒.rar (12.18 KB)

下載次數: 5

2015-11-28 15:15

下載 (36.23 KB)

2015-11-28 15:17

RCRG

RCRG 發表於 2015-11-28 15:17

    對了！由於有些使用者不見的會用 "B3~B79欄預設規則" 按鍵 去填入號碼，而是用同樣邏輯自己"手動"方式一一去填入B欄號碼，所以希望彈出視窗提醒的方式是有輸入錯提醒即可，下一個欄位又輸入錯就再提醒，以此類推，但如果輸入正確就無需提醒，避免一直彈出視窗，影響使用者作業。

另外不知可否再幫我做一個 "取消提醒" 的按鍵以供己身另外需求，先感謝各位大大了！

GBKEE

回復 2# RCRG


試試看

1. '工作表A 模組
   
2. Option Explicit
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.     Dim E As Range, M As String
   
5.     'Intersect 方法 傳回 Range 物件，此物件代表兩個或多個範圍重疊的矩形範圍。
   
6.     For Each E In Target
   
7.         If Not Application.Intersect(E, [B3:B79]) Is Nothing Then
   
8.             'IF(C3="""","""",3^(1-COUNT(MATCH(C3,AA$3:AA$500,))))"
   
9.             M = "IF(" & E(1, 2).Address & "="""","""",3^(1-COUNT(MATCH(" & E(1, 2).Address & ",AA$3:AA$500,))))"
   
10.             If E <> Application.Evaluate(M) Then MsgBox E.Address(0, 0) & "= " & E & " 填入號碼與預設不同"
    
11.         End If
    
12.     Next
    
13. End Sub

複製代碼

准提部林

Private Sub Worksheet_Change(ByVal Target As Range)
Dim E As Range, M, N
If [B1] = 111 Then Exit Sub　'作動〔關閉〕　
For Each E In Target
　　If Not Application.Intersect(E, [B3:B79]) Is Nothing Then
　　　M = Application.Match(E(1, 2), [AA3:AA500], 0)
　　　If IsError(M) Then N = 3 Else N = 1
　　　If E(1, 2) = "" Then N = ""
　　　If E <> N Then
　　　　MsgBox "輸入內容錯誤！將自動修正～～　"
　　　　Application.EnableEvents = False
　　　　E = N
　　　　Application.EnableEvents = True
　　　End If
　　End If
Next
End Sub

准提部林

　　　If E <> N Then
　　　　MsgBox "輸入內容錯誤！將自動〔還原〕～～　"
　　　　Application.EnableEvents = False
　　　　Application.Undo '執行還原指令
　　　　Application.EnableEvents = True
　　　End If

RCRG

回復 3# GBKEE

回復 5# 准提部林

感謝GBKEE大和准大的答案，GBKEE大的 "每一欄錯誤說明" 和 准大的 "自動還原"，讓我見識了各有不同的設計巧妙，只是不知能否幫我設計 "一鍵取消提醒" 的按鈕，因為有時會需要輸入與預設不同的號碼，而准大的 "自動還原" 恰好會阻擋了這種偶爾的需求；

另外兩位大大美中不足的共通點是，若C欄沒有內容，那麼對應B欄的輸入限制也能否能幫我忽略呢？   

以上，謝謝解惑者！

准提部林

回復 6# RCRG


If [B1] = 111 Then Exit Sub　
Ｂ１輸入111，不執行

Ｃ欄空格，不理會：
'If E(1, 2) = "" Then N = ""　刪去
If E <> N And E(1, 2) <> "" Then　加入判斷

RCRG

回復 7# 准提部林


哈！原來 "解除欄位" 已經有幫我設計在B1啦！個人才疏學淺，抱歉！
    試了半天，是不是要刪除兩行呢，因為只是刪除一欄好像會有問題呢；

對了！准大的 "自動還原" 效果是VBA中的哪一行呢?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim E As Range, M, N
If [B1] = 111 Then Exit Sub　'作動〔關閉〕　
For Each E In Target
　　If Not Application.Intersect(E, [B3:B79]) Is Nothing Then
　　　M = Application.Match(E(1, 2), [AA3:AA500], 0)
　　　If IsError(M) Then N = 3 Else N = 1
　　　' 這欄可以刪除對吧  If E(1, 2) = "" Then N = ""
　　　' 這欄也要刪除對吧  If E <> N Then
If E <> N And E(1, 2) <> "" Then
　　　　MsgBox "輸入內容錯誤！將自動修正～～　"
　　　　Application.EnableEvents = False
　　　　E = N
　　　　Application.EnableEvents = True
　　　End If
　　End If
Next
End Sub

RCRG

回復 7# 准提部林

    Sorry！我弄懂准大的字意了！紅色字是刪去的，藍色字是加進去的，黑色字是原本的，.....XD

RCRG

回復 6# RCRG


   謝謝准大指導，讓我也可以一並修改GBKEE大的VBA

'工作表A 模組
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim E As Range, M As String
    'Intersect 方法 傳回 Range 物件，此物件代表兩個或多個範圍重疊的矩形範圍。
    For Each E In Target
        If Not Application.Intersect(E, [B3:B79]) Is Nothing Then
            'IF(C3="""","""",3^(1-COUNT(MATCH(C3,AA$3:AA$500,))))"
            M = "IF(" & E(1, 2).Address & "="""","""",3^(1-COUNT(MATCH(" & E(1, 2).Address & ",AA$3:AA$500,))))"
            If E <> Application.Evaluate(M) And E(1, 2) <> "" Then MsgBox E.Address(0, 0) & "= " & E & " 填入號碼與預設不同"
        End If
    Next
End Sub