| |
▼ハットリ さん：
こんばんは。
>リストボックスのRowSourceプロパティに
↑のリストボックスは、ユーザーフォームに配置したものですね？
>シート上のセル範囲を指定して複数列表示させているのですが、
>シート上でオートフィルタを使い表示させた行のみをリストボックスに
>連動して表示させることはできないでしょうか。
フィルタ操作後、瞬時にユーザーフォーム上のリストボックスに
反映させるということですね？
Autofilter_Changeというイベントがあればいいんですが・・・・。
思いついたのは、ワークシート関数を配置してCaluculateイベントを発生してもらう
方法なんですが・・・。
仮にSheet1のセルA1から、以下のデータが入っているものとします。
項目1 項目2 項目3
1 2004/1/28 a
2 2004/1/29 b
3 2004/1/30 c
4 2004/1/31 d
5 2004/2/1 e
6 2004/2/2 f
7 2004/2/3 g
8 2004/2/4 h
9 2004/2/5 I
10 2004/2/6 j
11 2004/2/7 k
12 2004/2/8 l
13 2004/2/9 m
14 2004/2/10 n
15 2004/2/11 o
16 2004/2/12 p
17 2004/2/13 q
18 2004/2/14 r
19 2004/2/15 s
20 2004/2/16 t
21 2004/2/17 u
この3列をフィルタ操作後、リストボックスに反映させることを考えました。
ユーザーフォーム（Userform1）には、リストボックス（Listbox1）のみ配置して下さい
コードは､
標準モジュールに、
'=============================================================
Public rng As Range
Sub main()
Application.Calculation = xlAutomatic
UserForm1.Show vbModeless
End Sub
'=============================================================
Function chk_autofilter(wk As Worksheet) As Boolean
'input wk チェックするワークシート
'Out chk_autofilter true オートフィルター実行中
' false 実行していない
'ここのチェックは、もっと条件を付けないとまずいかもしれません
On Error Resume Next
chk_autofilter = True
Set fl = wk.AutoFilter.Range
If Err.Number <> 0 Then
chk_autofilter = False
End If
On Error GoTo 0
End Function
ユーザーフォーム（Userform1）のモジュールに、
'=============================================================
Private Sub UserForm_Initialize()
With Worksheets("sheet1")
If chk_autofilter(Worksheets("sheet1")) = True Then
Selection.AutoFilter
End If
Set rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
If rng.Row > 1 Then
Application.EnableEvents = False
Worksheets("sheet1").Range("z1").Formula = "=subtotal(3," & rng.Address & ")"
' セルz1に、ワークシート関数を入れておきました。セルの位置はとこでも
' いいです
rng.Offset(-1, 0).Resize(rng.Count + 1, 3).AutoFilter
ListBox1.BoundColumn = 3
ListBox1.List = rng.Resize(, 3).Value
Application.EnableEvents = True
End If
End Sub
'=============================================================
Private Sub UserForm_Terminate()
If chk_autofilter(Worksheets("sheet1")) = True Then rng.AutoFilter
Worksheets("sheet1").Range("z1").Value = ""
End Sub
シート（Sheet1）のモジュールに
'=============================================================
Private Sub Worksheet_Calculate()
Dim f_rng As Range
Application.EnableEvents = False
If chk_autofilter(Me) = True Then
UserForm1.ListBox1.Clear
Set f_rng = get_rng()
If Not f_rng Is Nothing Then
ReDim d_list(1 To f_rng.Count, 1 To 3)
kdx = 1
For idx = 1 To f_rng.Areas.Count
For jdx = 1 To f_rng.Areas(idx).Count
d_list(kdx, 1) = f_rng.Areas(idx).Cells(jdx).Value
d_list(kdx, 2) = f_rng.Areas(idx).Cells(jdx, 2).Value
d_list(kdx, 3) = f_rng.Areas(idx).Cells(jdx, 3).Value
kdx = kdx + 1
Next jdx
Next idx
UserForm1.ListBox1.List() = d_list()
End If
End If
Application.EnableEvents = True
End Sub
'=============================================================
Function get_rng() As Range
On Error Resume Next
Set get_rng = Nothing
Set get_rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End Function
これで、mainを実行してみてください。
尚、フィルタモードには､ユーザーフォーム表示と一緒になりますので、
フィルタモードＯＦＦの状態で実行してみて下さい。
|
|
