- 帖子
- 262
- 主題
- 8
- 精華
- 0
- 積分
- 280
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- HK
- 註冊時間
- 2015-8-11
- 最後登錄
- 2025-3-24
|
2#
發表於 2020-10-31 10:35
| 只看該作者
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim rng As Range, s$, k, t, xd As Object, i&, j&
- If Target.Cells.Count > 1 Then Exit Sub
- Set rng = [i2:l2]
- If Application.Intersect(rng, Target) Is Nothing Then Exit Sub
- If Target = rng(rng.Cells.Count) Then Exit Sub
- If d Is Nothing Then Call zz: Exit Sub
- Set xd = CreateObject("scripting.dictionary")
- For j = 1 To rng.Cells.Count
- s = s & rng(j).Value & "|"
- If Target = rng(j) Then Exit For
- Next
- 1000
- k = Filter(d.keys, s)
- For Each t In k
- xd(Split(t, "|")(j)) = ""
- Next
- t = Join(xd.keys, ",")
- If t = "" Then s = s & "|": j = j + 1: rng(j).Validation.Delete: GoTo 1000
- With rng(j + 1).Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
- xlBetween, Formula1:=t
- End With
- Application.EnableEvents = 0
- i = InStr(t, ",")
- Select Case i
- Case 0: rng(j + 1) = t
- Case 1: rng(j + 1) = Mid(t, 2)
- Case Else: rng(j + 1) = ""
- End Select
- rng(j + 1).Select
- Application.EnableEvents = 1
- End Sub
- Sub zz()
- Set d = CreateObject("scripting.dictionary")
- Dim a, b(), s$, k
- a = [a1].CurrentRegion.Value
- ReDim b(UBound(a, 2) - 1)
- For i = 2 To UBound(a)
- d(a(i, 1)) = ""
- For j = 1 To UBound(a, 2)
- b(j - 1) = a(i, j)
- Next
- d(Join(b, "|")) = ""
- Next
- s = Join(Filter(d.keys, "|", False), ",")
- With [i2].Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
- xlBetween, Formula1:=s
- End With
- Application.ScreenUpdating = 0
- Application.EnableEvents = 0
- [i2:l2] = ""
- Application.ScreenUpdating = 1
- Application.EnableEvents = 1
- MsgBox "Please select item form " & [i1].Value & " first"
- [i2].Select
- End Sub
|
-
-
zz.zip
(18.89 KB)
|
