オートフィルタをフォーム上（VBA)で実現 2回目

http://okwave.jp/qa/q8423348.html

前回も、オートフィルタをフォーム上で実現させる方法について
質問させていただきました。　Excel2003を仕様しております。

一通り、オートフィルタをフォーム上で再現することは出来たのですが、
使い方が悪いのか、上手く表示できないことがあります。

例）
ユーザーフォーム上にCombobox1～Combobox3まであります。
Comboboxどれかが変更されたら、空のコンボボックスのリストを再取得します。

-----------------------------------------------
Sub Combobox_Renew_ChangeJob(ByVal ComboboxName As Object, ByVal ColumnNumber As Long)
Application.ScreenUpdating = False '画面更新しない（ちらつき防ぐ）

With ThisWorkbook.Worksheets("データ")

If ComboboxName = "" Then 'コンボボックスが空だった場合
.Select
.Range("A1").AutoFilter Field:=ColumnNumber 'フィルター解除！

ElseIf ComboboxName <> "" Then 'コンボボックスが空じゃない場合
.Select
.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=ComboboxName.Text
End If

Result = WorksheetFunction.Subtotal(3, Range("B:B")) 'B列の可視セルがいくつあるか
If Result = 1 Then
MsgBox "一致するデータはありませんでした。" & vbCrLf & "　再度絞り込みなおしてください。"
.Select
.Range("A1").AutoFilter Field:=ColumnNumber 'フィルター解除！
ComboboxName = ""
End If

End With
Call ComboBox_Renewal 'コンボボックス更新
End Sub

------------------------------------------------------------

Sub ComboBox_Renewal()
Application.ScreenUpdating = False '画面更新しない（ちらつき防ぐ）
Dim LastData As Long
With ThisWorkbook.Worksheets("データ")
.Select
LastData = Cells(Rows.Count, 2).End(xlUp).Row 'B列最終行を取得

If (Me.ComboBox1 = "") Then
Me.ComboBox1.Clear
Me.ComboBox1.List = Module1.Get_Unique_and_Visible_List(.Range("E2：E" & LastData)) '[E]
Me.ComboBox1.AddItem ""
Else
Result = Combo1.ListIndex
Me.ComboBox1.Clear
Me.ComboBox1.SetFocus

End If

If (Me.ComboBox2 = "") Then
Me.ComboBox2.Clear
Me.ComboBox2.List = Module1.Get_Unique_and_Visible_List(.Range("C2：C" & LastData)) '[C]
Me.ComboBox2.AddItem ""
End If

If (Me.ComboBox3 = "") Then
Me.ComboBox3.Clear
Me.ComboBox3.List = Module1.Get_Unique_and_Visible_List(.Range("D2：D" & LastData)) '[D]
Me.ComboBox3.AddItem ""
End If
End With
End sub
------------------------------------

Private Sub ComboBox1_AfterUpdate()
Application.ScreenUpdating = False '画面更新しない（ちらつき防ぐ）

With ThisWorkbook.Worksheets("データ")
Call Combobox_Renew_ChangeJob(ComboBox1, .Range("E1").Column)
End With
End Sub


Private Sub ComboBox2_AfterUpdate()
Application.ScreenUpdating = False '画面更新しない（ちらつき防ぐ）
With ThisWorkbook.Worksheets("データ")
Call Combobox_Renew_ChangeJob(ComboBox2, .Range("C1").Column)
End With
End Sub

Private Sub ComboBox3_AfterUpdate()
Application.ScreenUpdating = False '画面更新しない（ちらつき防ぐ）
With ThisWorkbook.Worksheets("データ")
Call Combobox_Renew_ChangeJob(ComboBox3, .Range("D1").Column)
End With
End Sub
-----------------------------------------

上記の方法を使っていますが、
Comboboxに値を全て入れたあと、
絞り込みされていると考え、リストを更新しておりません。
そのため、最初のほうにコンボボックスにデータを入力したものは
選択できてしまいます。

一番最初に選んだComboboxは、
リストが全て残っている状態です。
そのため、他のComboboxで絞り込んだ後、
一番最初に選んだComboboxでは他の値が選択できてしまいます。

説明が下手で分かりにくいかもしれませんが…
何か良い改善方法があれば、教えて頂きたいです！
よろしくお願い致します!!

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2014/06/14 16:37

こんにちは。

申し訳ないのですが、個人的感想としては、ここまで作ってしまったら、作った当人以外、直す人はいないと思ったほうがよいかもしれません。

通常、これは、小さなブックを作り、メニューなどを非表示にしたワークシートだけで済ませるほうが普通だと思います。こういう点では、Excel2003の方が自由度が高いはずです。

それから、コードのいくつかの点で、可動するようには思えない部分があるのと、生きていない部分があるように思いました。

私自身は、このようなことが起きた場合は、頑張ることをしないで、全面的に最初からやり直すことをしています。要するに、設計段階での考え方の問題が多いわけです。

ただ、よくみると、分かりにくい部分はあるものの、コードとしては単純です。

>Sub Combobox_Renew_ChangeJob(ByVal ComboboxName As Object, ByVal ColumnNumber As Long)

「ByVal ComboboxName As Object 」　というのは、ありえるのでしょうか。
ByVal では、Object はパラメータとしてひき受けられないはずです。それに、ComboboxName は、暗黙のValue値になっています。

それで、わたし流に、全面的に書き換えてみました。重複するプロシージャ名はありません。
ComboBox にデータを入力して、Enterで起動します。ただ、個人的に、VBAはかなり忘れつつあります。しかし、本来、これはクラスから作ったほうが良いような気がしています。Indexが取れないのをコントロール名から取得しているからです。

なお、本質問とは関係ありませんが、先日、レスが付かずに、削除された質問についても、回答は作りましたが、そのままになってしまいました。完全ではないのですが、作りましたので、もし興味があれば、ここに出しておきます。

'//----
'UserFormモジュールのみ
Dim shData As Worksheet
Private Sub UserForm_Initialize()
　Set shData = ThisWorkbook.Worksheets("データ")
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　Dim Ar() As Variant
　If KeyCode <> 13 Then Exit Sub
　With shData
　If .AutoFilterMode = False Then Exit Sub
　　ComboBoxReflesh
　End With
End Sub
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　Dim Ar() As Variant
　If KeyCode <> 13 Then Exit Sub
　With shData
　If .AutoFilterMode = False Then Exit Sub
　　ComboBoxReflesh
　End With
End Sub
Private Sub ComboBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　Dim Ar() As Variant
　If KeyCode <> 13 Then Exit Sub
　With shData
　If .AutoFilterMode = False Then Exit Sub
　　ComboBoxReflesh
　End With
End Sub

'
Sub ComboBoxReflesh()
Dim AcCombo As Object
Dim i As Long, k As Long
Dim cb As Control
　 If TypeName(ActiveControl) <> "ComboBox" Then Exit Sub
　 Set AcCombo = ActiveControl
　 'ComboBox のインデックスを取得(二桁有効)
　 i = Application.Max(Val(Right(AcCombo.Name, 2)), Val(Right(AcCombo.Name, 1)))
　 '列への変換
　 Select Case i
　　 Case 1: k = 5
　　 Case 2: k = 3
　　 Case 3: k = 4
　　 Case Else: k = 99
　 End Select
　　With shData
　　If AcCombo.Text = "" _
　　 Or Application.CountIf(.AutoFilter.Range.Columns(k), AcCombo.Text) = 0 _
　　 Or k = 99 Then
　　　MsgBox "一致するデータはありませんでした。" & vbCrLf & _
　　　"　再度絞り込みなおしてください。", vbExclamation
　　　.AutoFilter.ShowAllData
　　　AcCombo.Value = ""
　　　KeyCode = 0
　　Else
　　 .AutoFilter.ShowAllData
　　　ComboboxClear i
　　　ComboBoxInput i, k, ActiveControl.Value
　　End If
　　End With
End Sub

Sub ComboBoxInput(ComboNo As Long, FldNo As Long, CBVal As Variant)
Dim Ar() As Variant
'出てきた配列を、ComboBox に戻す
　With shData
　.Range("A1").AutoFilter Field:=FldNo, Criteria1:=CBVal
　MakingList .AutoFilter.Range.Columns(5), Ar()
　If ComboNo <> 1 Then ComboBox1.List = Ar()
　MakingList .AutoFilter.Range.Columns(3), Ar()
　If ComboNo <> 2 Then ComboBox2.List = Ar()
　MakingList .AutoFilter.Range.Columns(4), Ar()
　If ComboNo <> 3 Then ComboBox3.List = Ar()
　End With
End Sub

Sub MakingList(Rng As Range, Ar() As Variant)
'AutoFilter の内容から一意のデータを出す
　Dim c As Range
　Set Rng = Rng.Offset(1).Resize(Rng.Rows.Count - 1)
　ReDim Ar(0)
　For Each c In Rng.SpecialCells(xlCellTypeVisible)
　　If c.RowHeight > 0 Then
　　　If UBound(Filter(Ar, c.Value)) = -1 Then
　　　　Ar(i) = c.Value
　　　　i = i + 1
　　　　ReDim Preserve Ar(i)
　　　End If
　　End If
　Next c
　ReDim Preserve Ar(i - 1)
End Sub
Sub ComboboxClear(ComboNo As Long)
'前のValueを消す--データの消去は不要
Dim cb As Control
　　　For Each cb In Me.Controls
　　　 If TypeName(cb) Like "ComboBox*" Then
　　　　 If Application.Max(Val(Right(cb.Name, 2)), Val(Right(cb.Name, 1))) <> ComboNo Then
　　　　　 cb.Value = ""
　　　　 End If
　　　 End If
　　　Next cb
End Sub

'//----x

この回答へのお礼

回答ありがとうございます。
Enterで起動するんですね…
んー。Enterじゃないと起動できない…という事でしょうか？
中々…Enterで決定していく人は居ないので
難しそうな気もします。
1文1文、意味を理解しながら
自分のコードと何が違うのか見比べて
勉強していこうと思います。

回答ありがとうございました！

お礼日時：2014/06/16 09:13

No.2 回答者： WindFaller 回答日時： 2014/06/16 09:28

こんにちは。

>Enterで起動するんですね…

別に何でもいいのですが、「入力」して「決定」という判断は必要ですね。
実際に、AterUpdate　は、あまり使われません。

別に何でもよいとは思うのですが、文字を入れたら、すぐに起動するという方法を私は選ばないのは、
入力の間違いもあるからです。

例えば、見つからなかった場合にも、次のコントロールに
行ってしまうよりも、そこにカーソルがとどまったほうがよいのでは？
そういう時の独特のテクニックを使いました。

この回答へのお礼

回答ありがとうございます。
言い忘れておりましたが、
コンボボックスは、自分で入力が出来ない形式になってます。
頂いた意見を参考に、考え直してみたいと思います。
ありがとうございました！

お礼日時：2014/06/19 12:04

No.3 回答者： WindFaller 回答日時： 2014/06/20 16:45

こんにちは。

>コンボボックスは、自分で入力が出来ない形式になってます。
それでしたら、ComboBox のKeyDownイベントではあまりうまくないですね。
本当は、CombBox の部分を全面的に書き換えたほうがよいかもしれません。
もともと、同じ仕様のマクロだけは避けたいと思ったのが発端ですから。

ユーザーがCombBox のリストを選択するものでしょうか。
ただ、CombBox で、Change イベントは辞めたほうがよいということだけは言っておきます。
理由は、何らかの加減で、ComboBoxのリストが開いたまま止まってしまいます。

AfterUpdateでも、悪くはないのですが、これは、厳密には、次のコントロールに移る時に発生しているような記憶があります。実用性からすると、何か「確定」という意志を払わすイベント(例：Click,　DoubleClick等、Enter, Tab)を設けないと、そのまま先に動いてしまいます。

ただ、そもそも、自コントロールの中身のリストを、自分のイベントで、内容を書き換えるということは考えたことはありません。他にも、ListBoxのように、それにふさわしいものがありそうな気がしますが、それは、レイアウトや現場のユーザーに依存しますから、私からは、なんとも言えません。

この回答へのお礼

回答ありがとうございます。
なんとなく、どうすればいいのか見えてきました。
もう少しじっくり考えてみたいと思います。

ありがとうございました！

お礼日時：2014/06/23 13:52