| |
▼めがねﾁｬﾝ さん：
こんにちは
>このような入力画面があります。
>Bの列に Bの列の入力履歴を リストとして設定しました。
入力画面と履歴が同じというのがわかりにくいのですが
Ｂ列の下に入力していく・・・という事と読み替えて
必要なのはＡ列と同じ項目の重複しないリストなので
Dictionaryオブジェクトを使って全てリストアップする必要も
無いと思いますので、一致した項目のリストを作成するように
サンプルを作ってみました。
結構、変更を加えてしまっているので
まずはサンプルを解読してみてください。
Public Function GetSummary(RR As Range) As String
Dim strKey As String
Dim K As String
Dim V As Variant
Dim i As Long
strKey = RR.Offset(, -1).Value
V = Me.Range(Me.Range("A1"), RR.Offset(-1)).Value
For i = 1 To UBound(V)
If V(i, 1) = strKey And Not K Like "*" & V(i, 2) & "*" Then
K = K & "," & V(i, 2)
End If
Next i
GetSummary = Mid$(K, 2)
End Function
'****************************************
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myList As String
If Target.Column = 2 Then
If Target.Offset(, -1).Value = "" Then Exit Sub
myList = GetSummary(Target)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=myList
.ShowError = False
End With
End If
End Sub
|
|
もも
- 09/6/17(水) 11:18 -
