- 帖子
- 262
- 主題
- 8
- 精華
- 0
- 積分
- 280
- 點名
- 17
- 作業系統
- xp
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- HK
- 註冊時間
- 2015-8-11
- 最後登錄
- 2024-11-19
|
3#
發表於 2018-7-2 21:44
| 只看該作者
Dim d As Object, k, t, s$- Private Sub Worksheet_Activate()
- If d Is Nothing Then dic
- End Sub
- Private Sub Worksheet_Change(ByVal Target As Range)
- Application.EnableEvents = 0
- Set td = Application.Intersect([b1:b3], Target)
- If Not td Is Nothing Then
- If Len(td.Value) Then
- k = td.Value: [b1:b3] = "": td.Value = k
- a = Array("CD#", "DC#", "CO#")
- k = a(td.Row - 1) & td.Value
- ar = Sheets("資料庫").[a1].CurrentRegion.Value
- If d Is Nothing Then dic
- t = Split(d(k), "|")
- ReDim b(1 To UBound(t), 1 To UBound(ar, 2))
- For i = 1 To UBound(t)
- b(i, 1) = i
- For j = 2 To UBound(ar, 2)
- b(i, j) = ar(t(i), j)
- Next
- Next
- [a5].CurrentRegion.Offset(4).Clear
- [a5].Resize(i - 1, j - 1) = b
- End If
- End If
- Application.EnableEvents = 1
- End Sub
- Sub dic()
- Set d = CreateObject("scripting.dictionary")
- ar = Sheets("資料庫").[a1].CurrentRegion.Value
- For i = 2 To UBound(ar)
- d("CO#" & ar(i, 4)) = d("CO#" & ar(i, 4)) & "|" & i
- d("CD#" & ar(i, 6)) = d("CD#" & ar(i, 6)) & "|" & i
- d("DC#" & ar(i, 7)) = d("DC#" & ar(i, 7)) & "|" & i
- Next
- For Each t In Array("CD#", "DC#", "CO#")
- k = Filter(d.keys, t): s = ""
- For i = 0 To UBound(k)
- k(i) = Replace(k(i), t, "")
- Next
- For i = 0 To UBound(k) - 1
- For j = i + 1 To UBound(k)
- If k(j) < k(i) Then t = k(i): k(i) = k(j): k(j) = t
- Next
- Next
- n = n + 1
- With Range("b" & n).Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
- xlBetween, Formula1:=Join(k, ",")
- End With
- Next
- End Sub
|
-
-
zz.zip
(35.06 KB)
|
