[發問] 資料輸入防呆問題請教

rouber590324

DEAR ALL 大大
1.RANGE("C4:C25") 與 RANGE("D4:D25") 為提供經辦輸入之範圍
   1.1 例  C4輸入A    D4輸入1 則 A1為KEY
           當  C5輸入A 時D5一定要輸入1否則秀出防呆"RANGE("D5")需輸入1"告之經辦.
           1.1.1 D6-D25 只要有相同情形均秀出防呆
       例  C10輸入B   D10輸入9 則 B9為KEY
           當  C11輸入B 時D11一定要輸入9否則秀出防呆"RANGE("D11")需輸入9"告之經辦.
           1.1.1 D11-D25 只要有相同情形均秀出防呆
2.請教如何書寫 VBA  煩不吝賜教   THANKS

luhpro

DEAR ALL 大大
1.RANGE("C4:C25") 與 RANGE("D425") 為提供經辦輸入之範圍
   1.1 例  C4輸入A    D4輸 ...
rouber590324 發表於 2014-12-31 13:32

一般要告訴使用者訊息並等待其回覆(或按"確定"鈕)的需求,
可以使用   Msgbox "要告知的訊息"    即可.

不過觀察你上方的敘述內容,
我發現你有多次強調   "一定要輸入..."   要求使用者看到訊息後必須做的動作.

而換個角度想,
若不影響使用者實際作業的情形下,
你可以考慮直接在VBA程式中代替使用者做這個動作.

例如 : 當  C5輸入A 時D5一定要輸入1
就用   If [C5] = "A" Then  [D5]=1  即可.

另外在你的敘述中:
假設 [C4][D4] = A1 時, 當 C5~C25  輸入 A 時,該列的 Dx 就要為 1
假設 [C10][D10] = B9 時, 當 C11~C25  輸入 B 時,該列的 Dx 就要為 9

問題來了, 假設使用者操作上述兩步驟之後 -
1. CxDx 的對應關係是否全部(即第 4 列 ~ 第 25 列)適用, 還是只是往下適用?)

2. 若在 C5 輸入 B 時, D5 讓不讓使用者改? 還是照樣只能輸入 9 ?
   2.1. 假設接受使用者修改 D5=6 , 那之前已經輸入的 D10(甚至其他相同情形) 是否也(都)要改成 6 ? 又是否只是往下適用?

   2.2 假設不接受使用者修改, 那萬一是之前使用者輸入錯誤的話, 那又是否提供修正的機制?

此處先假設全部適用, 且後令蓋前令.

1. Dim vD
   
2. 
   
3. Option Explicit
   
4. 
   
5. Private Sub Worksheet_Change(ByVal Target As Range)
   
6.   Dim sStr$
   
7.   Dim rTar As Range
   
8.   
   
9. On Error GoTo errWsChg
   
10. 
    
11.   With Target
    
12.     If .Column = 3 Then ' C欄
    
13.       If .Offset(, 1) <> "" Then
    
14.         sStr = .Text
    
15.         vD(CStr(.Value)) = .Offset(, 1)
    
16.       Else
    
17.         .Offset(, 1) = vD(CStr(.Value))
    
18.       End If
    
19.     Else ' D 欄
    
20.       If .Offset(, -1) <> "" Then
    
21.         sStr = .Offset(, -1).Text
    
22.         vD(CStr(.Offset(, -1))) = .Value
    
23.       End If
    
24.     End If
    
25.     For Each rTar In Range([C4], [C25])
    
26.       With rTar
    
27.         If .Value = sStr And .Offset(, 1) <> "" Then
    
28. Application.EnableEvents = False
    
29.           .Offset(, 1) = vD(sStr)
    
30. Application.EnableEvents = True
    
31.         End If
    
32.       End With
    
33.     Next
    
34.   End With
    
35.   
    
36. On Error GoTo 0
    
37. Exit Sub
    
38. 
    
39. errWsChg:
    
40.   Select Case Err.Number
    
41.     Case 13 ' 型態不符合
    
42.       Set vD = CreateObject("Scripting.Dictionary")
    
43.       Resume
    
44.       
    
45.     Case Else
    
46.       Resume Next
    
47.       
    
48.     End Select
    
49.    
    
50.   Resume Next
    
51. End Sub
    
52. 
    
53. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
54.   With Target
    
55.     If Not ((.Row > 3 And .Row < 26) And (.Column > 2 And .Column < 5)) Then
    
56.       MsgBox "非可輸入的範圍(僅可選擇 C4 ~ D25), 請重新點選..."
    
57.       If .Row > 3 And .Row < 26 Then
    
58.         .Offset(, 3 - .Column).Select ' 列在可變更範圍內,焦點強制移到 C欄
    
59.       Else
    
60.         .Parent.[C14].Select ' 強制移到 [C14]
    
61.       End If
    
62.     End If
    
63.   End With
    
64. End Sub

複製代碼

rouber590324

DEAR  luhpro
感謝您回覆之如此詳細.小弟非常感謝.依您提供之程式碼稍修改已可用
THANKS *10000