|
Public dic As Object
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ar(), i&, j&, strTarget$
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Sheets(2)
ar = .Range(.[A1], .Cells(Rows.Count, "C").End(3)).Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ar)
If Not dic.exists(ar(i, 1)) Then
Set dic(ar(i, 1)) = CreateObject("Scripting.Dictionary")
End If
dic(ar(i, 1))(ar(i, 2)) = ar(i, 3)
Next i
End With
If Not dic.exists(Target.Value) Then
Exit Sub
Else
Target.Select
If dic(Target.Value).Count = 1 Then
Target.Offset(, 1).Value = dic(Target.Value).keys()(0)
Target.Offset(, 2).Value = dic(Target.Value).items()(0)
Else
With Application.CommandBars.Add(Name:="myCell", Position:=msoBarPopup)
For i = 0 To dic(Target.Value).Count - 1
With .Controls.Add(Type:=msoControlButton)
.Caption = dic(Target.Value).keys()(i)
.OnAction = "Sheet1.myCellAction"
End With
Next
.ShowPopup
.Delete
End With
End If
End If
Set dic = Nothing
End Sub
Sub myCellAction()
Application.EnableEvents = False
Selection.Offset(, 1).Value = Application.CommandBars.ActionControl.Caption
Selection.Offset(, 2).Value = dic(Selection.Value)(Application.CommandBars.ActionControl.Caption)
Application.EnableEvents = True
End Sub
|
|