Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(その他 : その他)
入力フォームを使って複数の条件で検索したい
投稿日時: 23/05/09 19:31:51
投稿者: かうきのおやじ

1行目に項目見出しとして商品名・分類・機能・幅・高さという上記の5つの項目に分けた1レコード1行のデータベースが有るとします。
エクセルのフィルタ機能でそれぞれを絞り込めば複数の条件に合致する物だけを抽出できるのですが
それをマクロで作った入力フォームで一発検索したいのです。
 
検索する時の条件が上記の5つ全てが入力されている場合のコードまではできたのですが、1つだけの条件ですむ場合もあります。
また、幅・高さについては数字が入力されているので「○○cm以上」の時も有れば「○○cm以上○○cm以下」の場合もあります。
 
その時にフォームの入力欄が空白の時は無視して、条件が入力された項目だけで絞り込みする場合の
If Then Else を使ったコードはどのように書けばよろしいでしょうか?
 
もしくは別の方法が有ればご教示ください。
 
ちなみに、今使っているパソコンはWindows7でエクセルは2010の古いバージョンです。

回答
投稿日時: 23/05/09 21:47:50
投稿者: simple

こんばんは。
>検索する時の条件が上記の5つ全てが入力されている場合のコードまではできたのですが
それを示してもらえますか?

回答
投稿日時: 23/05/09 22:23:08
投稿者: WinArrow

マクロの記録で作成したコードをみると、
フィルタ横目1つに1行のコードが必要ということが分かります。
条件入力を省略した場合は、当がイルタ項目をスキップ(コード不要)
従って、
単純い考えると、
項目が5個:5行のコードで済みます。
 
問題は、1つの項目に複数条件の場合です。
配列を使うことによい、すっきりしたコードになると思います。
WEB検索すればヒントがあります。

投稿日時: 23/05/09 22:32:19
投稿者: かうきのおやじ

このようなコードを書いてます。
 
Sub 項目列でフィルタリング()
 
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim colSyumoku As Range
    Dim syumokuColumn As Long
    Dim colSyobunrui As Range
    Dim syobunruiColumn As Long
    Dim colKinou As Range
    Dim kinouColumn As Long
    Dim colmokuteki As Range
    Dim mokutekiColumn As Long
    Dim colHaba As Range
    Dim habaColumn As Long
    Dim colTakasa As Range
    Dim takasaColumn As Long
     
     
    Dim filteredRange As Range
    Dim lastRow As Long
     
    ' 対象のシートを指定する
    Set ws = ThisWorkbook.Sheets("FYGMST01.CSV")
     
    ' 対象のテーブルを指定する
    Set tbl = ws.ListObjects("テーブル5")
     
    ' 列の項目名を基に列番号を取得する
    Set colSyumoku = tbl.HeaderRowRange.Find("種目")
    Set colSyobunrui = tbl.HeaderRowRange.Find("小分類")
    Set colKinou = tbl.HeaderRowRange.Find("機能別")
    Set colmokuteki = tbl.HeaderRowRange.Find("目的別")
    Set colHaba = tbl.HeaderRowRange.Find("幅")
    Set colTakasa = tbl.HeaderRowRange.Find("高さ")
         
     
    ' 列番号を取得する
    If Not colSyumoku Is Nothing Then
        syumokuColumn = colSyumoku.Column
    Else
        MsgBox "列 '種目' が見つかりません。"
        Exit Sub
    End If
     
    If Not colSyobunrui Is Nothing Then
        syobunruiColumn = colSyobunrui.Column
    Else
        MsgBox "列 '小分類' が見つかりません。"
        Exit Sub
    End If
     
    If Not colKinou Is Nothing Then
        kinouColumn = colKinou.Column
    Else
        MsgBox "列 '機能別' が見つかりません。"
        Exit Sub
    End If
     
    If Not colmokuteki Is Nothing Then
        mokutekiColumn = colmokuteki.Column
    Else
        MsgBox "列 '目的別' が見つかりません。"
        Exit Sub
    End If
     
    If Not colHaba Is Nothing Then
        habaColumn = colHaba.Column
    Else
        MsgBox "列 '幅' が見つかりません。"
        Exit Sub
    End If
     
    If Not colTakasa Is Nothing Then
        takasaColumn = colTakasa.Column
    Else
        MsgBox "列 '高さ' が見つかりません。"
        Exit Sub
    End If
     
     
     
    ' テーブルのデータ範囲を取得する
    Set filteredRange = tbl.DataBodyRange
     
    ' フィルターを解除する
    tbl.AutoFilter.ShowAllData
     
     
     
  'フォームの項目を読み込む
   
     
    ' 種目が「フォーム入力内容」の行に絞り込む
    filteredRange.AutoFilter Field:=syumokuColumn, Criteria1:=ListBox7.Text
        
    ' 小分類が「フォーム入力内容」の行に絞り込む
    filteredRange.AutoFilter Field:=syobunruiColumn, Criteria1:=ListBox6.Text
     
    ' 機能別が「フォーム入力内容」の行に絞り込む
    filteredRange.AutoFilter Field:=kinouColumn, Criteria1:=ListBox5.Text
     
    ' 目的別が「フォーム入力内容」の行に絞り込む
    filteredRange.AutoFilter Field:=mokutekiColumn, Criteria1:=ListBox4.Text
     
    ' 幅が「フォーム入力内容以上」の行に絞り込む
    filteredRange.AutoFilter Field:=habaColumn, Criteria1:=">="&ListBox3.Text
  
    ' 高さが「フォーム入力内容以下」の行に絞り込む
    filteredRange.AutoFilter Field:=takasaColumn, Criteria1:=">="&ListBox2.Text
  
  
  
     
End Sub

回答
投稿日時: 23/05/09 23:31:30
投稿者: simple

引用:
その時にフォームの入力欄が空白の時は無視して、条件が入力された項目だけで絞り込みする場合の
If Then Else を使ったコードはどのように書けばよろしいでしょうか?
    If ListBox7.Text <> "" Then
        filteredRange.AutoFilter Field:=syumokuColumn, Criteria1:=ListBox7.Text
    End If
というようなことでしょうか。

投稿日時: 23/05/13 09:24:58
投稿者: かうきのおやじ

「空白でない場合は」という条件の時は「<>""」を使えばいいんですね。
ありがとうございます。
初歩から勉強しなおします。 Idea