オートフィルタがかかっている列を探す自作アドインに即時検索を追加した

以前にオートフィルタがかかっている列を検索するアドインを作成した。

www.excellovers.com

我ながらとても便利な機能で、使う時は立て続けに使いまくっている。

で、今日は久々に使いまくる機会があったのだがちょっと改良したくなるポイントがあったので修正したみた。

即時移動
コード

即時移動

どうなったかというと下記のようにしてみた

f:id:ExcelLover:20210914225709g:plain

今まではフォームに表示されたリストをクリックしないと該当列に移動しなかったが、該当する列が１つしかない場合に、即座に該当列に移動するようにしてみた。

ユーザーフォームを自動で閉じるかどうかはもうちょっと使ってみてから判断しようと思う。

コード

'ユーザーフォームのコードです
Option Explicit
Private Sub ComboBox1_Change()
     Call ListboxAdd(ComboBox1.Value)
     Me.TextBox1.SetFocus
End Sub

Private Sub CommandButton1_Click()
     Unload Me
End Sub

Private Sub UserForm_Initialize()
     Me.TextBox1.SetFocus
     Me.ListBox1.ColumnCount = 3
     Me.ListBox1.ColumnWidths = "130;50;120"
     Call ComboboxAdd
     If ComboBox1.ListCount >= 1 Then Call ListboxAdd(ComboBox1.Value)
'改修箇所↓        
     If ListBox1.ListCount = 1 Then FilterSearchResultJump 0
'改修箇所↑                    
End Sub
Private Sub TextBox1_AfterUpdate()
     Call ListboxAdd(ComboBox1.Value)
End Sub

Private Sub CheckBox1_Change()
     Call ListboxAdd(ComboBox1.Value)
     Me.TextBox1.SetFocus
End Sub
Sub ComboboxAdd()
     If ActiveSheet.AutoFilterMode Then
          ComboBox1.AddItem "オートフィルター"
     End If

     Dim myListObj As ListObject
     For Each myListObj In ActiveSheet.ListObjects
          ComboBox1.AddItem myListObj.Name
     Next
     
     If ComboBox1.ListCount >= 1 Then ComboBox1.Value = ComboBox1.List(0)
End Sub
Sub ListboxAdd(Optional FilterType As String = "オートフィルター")
     Dim myVar As Variant
     myVar = FilterSearch(Me.CheckBox1.Value, FilterType)
     
     Me.ListBox1.Clear
     Dim i As Long
     For i = 0 To UBound(myVar)
          If myVar(i)(1) Like "*" & Me.TextBox1.Value & "*" Then
               Me.ListBox1.AddItem myVar(i)(1)
               Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = myVar(i)(2)
               Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = myVar(i)(3)
          End If
     Next
End Sub

'改修箇所↓
Private Sub ListBox1_Click()
'リストボックスに表示された検索結果をクリックすると、検索結果へ移動する
     FilterSearchResultJump ListBox1.ListIndex
End Sub
Sub FilterSearchResultJump(ListIndex As Long)
    Dim JumpAddress As String
    
    JumpAddress = ListBox1.List(ListIndex, 1)
    Range(JumpAddress).Activate
End Sub
'改修箇所↑