- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
23#
發表於 2024-3-26 11:13
| 只看該作者
回復 22# aassddff736
以下是 學習資料驗證清單的方法,請前輩參考
儲位空位存放區清單:
儲位空位清單:
將以下代碼植入 主頁 工作表模組下
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
Dim Ad$, Arr, Z, xR As Range, i&
Set Arr = Intersect([主頁!B17].CurrentRegion, [主頁!B18:D65536])
If Me.UsedRange.Rows.Count <= 17 Then Exit Sub
If .Columns.Count > 1 Then Exit Sub
Set xR = Intersect(Arr.Resize(, 1), .Cells): Arr.Resize(, 2).Validation.Delete
If Not xR Is Nothing Then
If .Count > 1 Then Exit Sub
If Trim(.Value) = "" Then Exit Sub Else Arr = Arr
Set Z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Arr(i, 1) = .Value And Arr(i, 3) = "" Then Z(Arr(i, 2)) = ""
Next
With .Item(1, 2).Validation
If Z.Count > 0 Then .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(Z.KEYS(), ",")
End With
Set Z = Nothing: Arr = Empty: Exit Sub
End If
Set xR = Intersect(Arr.Resize(, 2), .Cells)
If Not xR Is Nothing Then
If .Count > 1 Then Exit Sub
If .Value = "" Then Exit Sub Else Arr = Arr
Set Z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr): Z(Arr(i, 1) & "/" & Arr(i, 2)) = i + 17: Next
If Z.EXISTS(.Item(1, 0) & "/" & .Value) Then Rows(Z(.Item(1, 0) & "/" & .Value)).Delete
Ad = .Cells(1, 2).Hyperlinks(1).SubAddress
Application.Goto Sheets(Split(Ad, "!")(0)).Range(Split(Ad, "!")(1))
Selection(1) = .Value: Set Z = Nothing: Arr = Empty
End If
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Arr, Z, i&, xR As Range
With Target
Set Arr = Intersect([主頁!B17].CurrentRegion, [主頁!B18:D65536])
Set xR = Intersect(Arr.Resize(, 1), .Cells): Arr.Resize(, 1).Validation.Delete: Arr = Arr
If Not xR Is Nothing Then
Set Z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" And Arr(i, 3) = "" Then Z(Arr(i, 1)) = ""
Next
With .Validation
If Z.Count > 0 Then .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(Z.KEYS(), ","): Set Z = Nothing: Arr = Empty
End With
End If
End With
End Sub |
|
