Piny-設置下述防呆機制(VBA)

piny · 发表于 2011-7-27 09:46

感謝藍老師協助，考量閱讀便利性，另開新帖求問。

第一問連結
http://club.excelhome.net/thread-739394-1-1.html

第二問連結
http://club.excelhome.net/thread-742825-1-1.html

第三問連結
http://club.excelhome.net/thread-744225-1-1.html

問題一：設置下述防呆機制

先敍述日後該工作表使用步驟：
1.執行「更新產業名」VBA
2.輸入B3, B4, B7, B8, C11~D15, H2~K11之資訊
3.執行「基準分析」VBA

故非上述操作步驟將皆提示錯誤，不給運行，依實際工作上經驗，下述為常見之錯誤習慣，希望可以改善，請以本樓附件修改代碼，謝謝！ ^^

情況一：
在執行「更新產業名」VBA時，先將整張工作表取消保護（即可以修改單元格值）

執行「基準分析」VBA時，先檢視有無下述情況，若有，則提示不給運行理由並離開VBA，若無，則開始執行，並於執行後將整張工作表保護（即不可以再修改單元格值）

情況二：
若B3之輸入資訊非其有效清單，則提示「請確認B3資訊是否為有效清單」，B4, B7, B8亦然

情況三：
若C11~D15之輸入資訊非介於0~1之整數(含)，則提示「請確認XX資訊是否為有效值」，XX請為出錯單元格位址

情況四：
若H2~K11完全未輸入資訊，則提示「請選填產業名或關鍵字」

蓝桥玄霜 · 发表于 2011-7-28 12:30

请见附件。
先显示一个按钮。

piny · 发表于 2011-7-28 12:39

謝謝藍老師

可是若執行基準分析想更改條件，我的預設作法係需重新執行「更新產業名」，所以若老師的作法係將按鈕隱藏，則要如何重作呢？

另請將EI16之公式先修正為
=IF(ISNA(MATCH(EI17,F3:F11,)),"",MATCH(EI17,F3:F11,))

避免B8可能選「否」產生的Bug

另可否貼出您的代碼，Excel打開全是亂碼，謝謝老師！ ^^

piny · 发表于 2011-7-28 16:50

補充一下簡体字代碼在繁体版Excel運行時，代碼區的漢字幾乎都會變成亂碼，想要修改也不曉得簡体字是寫什麼，

如下述連結情況
http://club.excelhome.net/viewth ... d=527467#pid5057407

故若蒙藍老師撥冗協助，請同步貼上您的代碼，俾小弟用人工修改！感恩！ ^^

蓝桥玄霜 · 发表于 2011-7-29 08:10

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If (Target.Column <> 3 And Target.Column <> 4) Or (Target.Row < 11 And Target.Row > 15) Then Exit Sub
If Target.Value < 1 And Target.Value > 0 Then
If Target.Column = 3 Then
If Target.Offset(0, 1) <> "" Then
If Target < Target.Offset(0, 1) Then
MsgBox "請確認" & Target.Address & "資訊是否為有效值？"
Application.EnableEvents = False
Target = ""
End If
End If
Else
If Target.Offset(0, -1) <> "" Then
If Target > Target.Offset(0, -1) Then
MsgBox "請確認" & Target.Address & "資訊是否為有效值？"
Application.EnableEvents = False
Target = ""
End If
End If
End If
Else
MsgBox "請確認" & Target.Address & "資訊是否為有效值？"
Application.EnableEvents = False
Target = ""
End If
Application.EnableEvents = True
End Sub
Sub jzfx()
Dim cel As Range, col%, x, i&, y, j&, Brr, ii&, jj&, ks, js, aa
Dim d1, k1, t1
Set d1 = CreateObject("Scripting.Dictionary")
Sheet11.Activate
ActiveSheet.Calculate
Application.Calculation = xlManual
n = Application.CountA(Sheet11.[h2:k11])
If n = 0 Then MsgBox "請在H2：K11選填產業名或關鍵字": Exit Sub
Brr = [h2:k11]
n = 17: [e19:en999] = ""
For i = 1 To UBound(Brr)
For j = 1 To 4
If Brr(i, j) <> "" Then
If j <> 4 Then
For ii = 0 To UBound(k(j))
If Brr(i, j) = k(j)(ii) Then
t(j)(ii) = Left(t(j)(ii), Len(t(j)(ii)) - 1)
x = Split(t(j)(ii), "*")
For jj = 0 To UBound(x)
d1(x(jj)) = d1(x(jj)) + 1
If d1(x(jj)) = 33 Then GoTo 100
Next
End If
Next
Else
For ii = 1 To UBound(Arr)
If InStr(Arr(ii, 11), Brr(i, j)) Then
y = Arr(ii, 1) & "|" & Arr(ii, 2) & "|" & Arr(ii, 8) & "|" & Arr(ii, 9) & "|" & Arr(ii, 10)
d1(y) = d1(y) + 1
If d1(y) = 33 Then GoTo 100
End If
Next
End If
End If
Next
Next
100:
k1 = d1.keys
For jj = 0 To UBound(k1)
y = Split(k1(jj), "|")
n = n + 1
Cells(n, 5) = n - 17
Cells(n, 6).Resize(1, 5) = y
Next
Call ndfx
Call afa
Application.ScreenUpdating = True
CommandButton1.Visible = False
CommandButton2.Visible = True
ActiveSheet.Protect
MsgBox "OK"
End Sub

复制代码

蓝桥玄霜 · 发表于 2011-7-29 08:13

请见附件。

piny · 发表于 2011-7-29 08:58

以7樓附件測試新問題如下

1.
C與D無絕對大小關係，故允許C11>D11
(兩者關係是取聯集，即小於C值『或』大於D值)

2.
希望執行「基準分析」VBA後，該活頁所有值皆不得再更改(可選取單元格、可複製單元格，不可刪除內容，不可貼上其他內容，不可輸入其他內容)，目前測試仍可以於執行後修正單元格值

3.
希望若B3, B4, B7, B8不是選擇清單有效值，比如在B8輸入「2010年」(原作僅以有效性防呆，可是仍有很多同事會以選擇性貼上值等方法運行，希望代碼於運行時先判讀這四格是不是有效清單值，若不是，就提示警語後離開。

4.
希望若C11~D15之輸入資訊非介於0~1之整數(含)，比如在C11輸入「是」(原作僅以有效性防呆，可是仍有很多同事會以選擇性貼上值等方法運行，希望代碼於運行時先判讀這四格是不是0~1之整數(含)，若不是，就提示警語後離開。

5.
同理，H2~J11亦希望代碼於運行時判讀是不是有效清單值

謝謝協助 ^^

[ 本帖最后由 piny 于 2011-7-29 09:00 编辑 ]

piny · 发表于 2011-7-29 09:18

原帖由 piny 于 2011-7-29 08:58 发表
以7樓附件測試新問題如下

1.
C與D無絕對大小關係，故允許C11>D11
(兩者關係是取聯集，即小於C值『或』大於D值)

後來和同事討論一下，上面這句敍述有誤，修正一下
應修正為
C與D若僅其一輸入(另一個為空白)，則僅需判讀該值需介於0與1之間(含)，若兩者同時輸入，則C必小於D(仍需判讀兩個值皆需介於0與1之間(含))
不是上述情況，皆需提示警示。

蓝桥玄霜 · 发表于 2011-7-29 14:13

1、4问题已经满足的了。

piny · 发表于 2011-7-29 14:30

執行完「更新產業名」VBA後，此時刪除D11，理應不用提示錯誤(因為只是改了條件，而且也還沒執行「基準分析」VBA)

		自动登录	找回密码
密码			免费注册

[求助] Piny-設置下述防呆機制(VBA)

有中文的代码