返回列表 上一主題 發帖

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

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

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 於 2015-1-1 08:19 編輯
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. Option Explicit

  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.   Dim sStr$
  5.   Dim rTar As Range
  6.   
  7. On Error GoTo errWsChg

  8.   With Target
  9.     If .Column = 3 Then ' C欄
  10.       If .Offset(, 1) <> "" Then
  11.         sStr = .Text
  12.         vD(CStr(.Value)) = .Offset(, 1)
  13.       Else
  14.         .Offset(, 1) = vD(CStr(.Value))
  15.       End If
  16.     Else ' D 欄
  17.       If .Offset(, -1) <> "" Then
  18.         sStr = .Offset(, -1).Text
  19.         vD(CStr(.Offset(, -1))) = .Value
  20.       End If
  21.     End If
  22.     For Each rTar In Range([C4], [C25])
  23.       With rTar
  24.         If .Value = sStr And .Offset(, 1) <> "" Then
  25. Application.EnableEvents = False
  26.           .Offset(, 1) = vD(sStr)
  27. Application.EnableEvents = True
  28.         End If
  29.       End With
  30.     Next
  31.   End With
  32.   
  33. On Error GoTo 0
  34. Exit Sub

  35. errWsChg:
  36.   Select Case Err.Number
  37.     Case 13 ' 型態不符合
  38.       Set vD = CreateObject("Scripting.Dictionary")
  39.       Resume
  40.       
  41.     Case Else
  42.       Resume Next
  43.       
  44.     End Select
  45.    
  46.   Resume Next
  47. End Sub

  48. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  49.   With Target
  50.     If Not ((.Row > 3 And .Row < 26) And (.Column > 2 And .Column < 5)) Then
  51.       MsgBox "非可輸入的範圍(僅可選擇 C4 ~ D25), 請重新點選..."
  52.       If .Row > 3 And .Row < 26 Then
  53.         .Offset(, 3 - .Column).Select ' 列在可變更範圍內,焦點強制移到 C欄
  54.       Else
  55.         .Parent.[C14].Select ' 強制移到 [C14]
  56.       End If
  57.     End If
  58.   End With
  59. End Sub
複製代碼

TOP

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

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題