こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

オートフィルタをフォーム上(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では他の値が選択できてしまいます。

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

投稿日時 - 2014-06-09 11:23:56

QNo.8629995

すぐに回答ほしいです

質問者が選んだベストアンサー

こんにちは。

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

通常、これは、小さなブックを作り、メニューなどを非表示にしたワークシートだけで済ませるほうが普通だと思います。こういう点では、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

投稿日時 - 2014-06-14 16:37:52

お礼

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

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

投稿日時 - 2014-06-16 09:13:47

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

こんにちは。

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

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

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

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

投稿日時 - 2014-06-20 16:45:57

お礼

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

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

投稿日時 - 2014-06-23 13:52:03

ANo.2

こんにちは。

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

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

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

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

投稿日時 - 2014-06-16 09:28:18

お礼

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

投稿日時 - 2014-06-19 12:04:24

あなたにオススメの質問