- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 16
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2015-1-1 08:13
| 只看該作者
本帖最後由 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 假設不接受使用者修改, 那萬一是之前使用者輸入錯誤的話, 那又是否提供修正的機制?
此處先假設全部適用, 且後令蓋前令.- Dim vD
- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim sStr$
- Dim rTar As Range
-
- On Error GoTo errWsChg
- With Target
- If .Column = 3 Then ' C欄
- If .Offset(, 1) <> "" Then
- sStr = .Text
- vD(CStr(.Value)) = .Offset(, 1)
- Else
- .Offset(, 1) = vD(CStr(.Value))
- End If
- Else ' D 欄
- If .Offset(, -1) <> "" Then
- sStr = .Offset(, -1).Text
- vD(CStr(.Offset(, -1))) = .Value
- End If
- End If
- For Each rTar In Range([C4], [C25])
- With rTar
- If .Value = sStr And .Offset(, 1) <> "" Then
- Application.EnableEvents = False
- .Offset(, 1) = vD(sStr)
- Application.EnableEvents = True
- End If
- End With
- Next
- End With
-
- On Error GoTo 0
- Exit Sub
- errWsChg:
- Select Case Err.Number
- Case 13 ' 型態不符合
- Set vD = CreateObject("Scripting.Dictionary")
- Resume
-
- Case Else
- Resume Next
-
- End Select
-
- Resume Next
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- With Target
- If Not ((.Row > 3 And .Row < 26) And (.Column > 2 And .Column < 5)) Then
- MsgBox "非可輸入的範圍(僅可選擇 C4 ~ D25), 請重新點選..."
- If .Row > 3 And .Row < 26 Then
- .Offset(, 3 - .Column).Select ' 列在可變更範圍內,焦點強制移到 C欄
- Else
- .Parent.[C14].Select ' 強制移到 [C14]
- End If
- End If
- End With
- End Sub
|
|
