| |
▼RIKE さん：
おはようございます。
出かけてしまうので、以下でうまくいかなかったら、
どなたかお願いします。
>
>>Userform1のモジュールに
>>
>>'========================================================
>>Dim rng As Range 'リストデータのセル範囲
>>Dim ev As Boolean 'Changeイベントの有無フラグ True--発生可能 False---発生不可
>>'========================================================
>>Private Sub UserForm_Initialize()
>> ComboBox1.Style = fmStyleDropDownCombo '←これは事前設定でよいです
With Worksheets("sheet1")
Set rng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp))
End With
>> ev = True
>>End Sub
>>'===============================================================
>>Private Sub ComboBox1_Change()
>> Dim svtext As String 'コンボボックスのTextの内容の一時保存
Dim r_add As String
>> If ev = False Then Exit Sub
>> With ComboBox1 '←適当な名前に変更すること
>> svtext = .Text
>> If .Text <> "" Then
>> If rng.Count = 1 Then
>> If rng.Value = "" Then
>> .Clear
>> Exit Sub
>> End If
>> End If
r_add = rng.Address(, , , True)
myvalue = Evaluate("transpose(if(mid(" & r_add & ",1," & Len(.Text) & ")=""" _
& .Text & """," & r_add & ",""" & Chr(&HFF) & """))")
>> If UCase(TypeName(myvalue)) <> UCase("variant()") Then
>> myvalue = Array(myvalue)
>> End If
>> myvalue = Filter(myvalue, Chr(&HFF), False)
>> '↑あり得ない文字を使用してフィルタをおこなう
>> ev = False
>> .Clear
>> .List() = myvalue
>> .Text = svtext
>> ev = True
>> If UBound(myvalue) > 0 Then
>> .DropDown
>> End If
>> Else
>> .Clear
>> .Visible = False
>> .Visible = True
>> .SetFocus '↑ここは、こうしないと残像が残るので（Excel2000）
>> End If
>> End With
>>End Sub
>>
>絞り込むシートを"sheet1"のＢ列にするとしたらどうなるのでしょうか？
これで試してみてください。
|
|
ichinose
- 06/6/15(木) 10:45 -
