厄洛斯 wrote:
今天進公司去試過確...(恕刪)
用VBA方式 看看
拿給的資料格式來做的
使用時客戶資料工作表 前4欄 務必為 代碼 地區 客戶名稱 部門 的順序
下面的程式碼貼到 要使用下拉的工作表裡
SheetName= 後面改成放客戶資料工作表的名稱
Const SheetName = "客戶清單" '資料工作表名稱
Const Col = "C1" '客戶代碼欄位
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count = 1 And Target.Column = Range(Col).Column Then
Dim List As String
With Sheets(SheetName)
List = Unique(.Range(.Cells(2, 2), .Cells(.UsedRange.Rows.Count, 2)))
End With
Target.Offset(0, 1).Validation.Delete
Target.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
Formula1:=List
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyKey As Integer '資料階層
MyKey = Target.Column() - Me.Range(Col).Column + 1
If Target.Count = 1 And MyKey > 1 And MyKey < 5 Then
Target.Offset(0, 1).Value = ""
Target.Offset(0, 1).Validation.Delete
Target.Offset(0, 1 - MyKey).Value = ""
If Target.Text <> "" Then
Dim Rng As Range
Set Rng = Sheets(SheetName).UsedRange
Rng.AutoFilter
If MyKey > 3 Then Rng.AutoFilter Field:=MyKey - 2, Criteria1:=Target.Offset(0, -2).Text
If MyKey > 2 Then Rng.AutoFilter Field:=MyKey - 1, Criteria1:=Target.Offset(0, -1).Text
Rng.AutoFilter Field:=MyKey, Criteria1:=Target.Text
If MyKey < 4 Then
Target.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
Formula1:=Unique(Rng.Resize(Rng.Rows.Count - 1, 1).Offset(1, MyKey).SpecialCells(xlCellTypeVisible))
ElseIf MyKey = 4 Then
Target.Offset(0, 1 - MyKey) = Rng.Resize(Rng.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).Range("A1")
End If
Rng.AutoFilter
End If
End If
End Sub
Function Unique(DD As Variant) As String '刪除重複
Dim D As Variant, Str As String
For Each D In DD
If InStr(Str, D) = 0 Then
Str = IIf(Str = "", D, Str & "," & D)
End If
Next D
Unique = Str
End Function
使用時點 DoubleClick 代碼欄位 地區欄位就會出現下拉選單
