エクセル練習問題:フィルターオプションの設定(VBA)


スポンサードリンク

問題    topへ

解答例    topへ

問題1の解答例    topへ

  1. コードの例1
    • 抽出条件をK2:K4に以下のように入力します。
      • これは完全一致で検索するためです。
      • 「岡田」と入力すると前方一致で検索されます。
      K
      2 担当者
      3 ="=岡田"
      4 ="=上村"
    Sub Adfilter1()
      Dim lrow As Long
      '検索条件をセルに入力
      Range("K2").Value = "担当者"
      Range("K3").Formula = "=""=岡田"""
      Range("K4").Formula = "=""=上村"""

      'データの抽出先をクリアする
      lrow = Range("B" & Rows.Count).End(xlUp)
      If lrow > 25 Then
        Range("B25:H" & lrow).ClearContents
      End If
      'フィルタオプションの設定でデータ抽出
      Range("B2:H19").AdvancedFilter _
         Action:=xlFilterCopy, _
         CriteriaRange:=Range("K2:K4"), _
         CopyToRange:=Range("B25"), _
         Unique:=False
    End Sub
  2. コードの例2
    • K2セルは空欄のままにします。もしくは、列見出しと重複しない文字列を入力します。
      操作手順等は省略します。
      K3セルに以下の数式を入力します。
      K
      2
      3 =OR(D3="岡田",D3="上村")
    • Sub Adfilter2()
        Dim lrow As Long
        '検索条件をセルに入力
        Range("K2").Value = ""
        Range("K3").Formula = "=OR(D3=""岡田"",D3=""上村"")"

        'データの抽出先をクリアする
        lrow = Range("B" & Rows.Count).End(xlUp)
        If lrow > 25 Then
          Range("B25:H" & lrow).ClearContents
        End If
        'フィルタオプションの設定でデータ抽出
        Range("B2:H19").AdvancedFilter _
           Action:=xlFilterCopy, _
           CriteriaRange:=Range("K2:K4"), _
           CopyToRange:=Range("B25"), _
           Unique:=False
      End Sub

問題2の解答例    topへ

  1. コードの例1
    • 抽出条件をK2:K3に以下のように入力します。
      • これは完全一致で検索するためです。
      • 「岡田」と入力すると前方一致で検索されます。
      K
      2 型番
      3 *W*
    • Sub Adfilter3()
        Dim lrow As Long
        '検索条件をセルに入力
        Range("K2").Value = "型番"
        Range("K3").Value = "*W*"

        'データの抽出先をクリアする
        lrow = Range("B" & Rows.Count).End(xlUp)
        If lrow > 25 Then
          Range("B25:H" & lrow).ClearContents
        End If
        'フィルタオプションの設定でデータ抽出
        Range("B2:H19").AdvancedFilter _
           Action:=xlFilterCopy, _
           CriteriaRange:=Range("K2:K3"), _
           CopyToRange:=Range("B25"), _
           Unique:=False
      End Sub
  2. コードの例2
    • K2セルは空欄のままにします。もしくは、列見出しと重複しない文字列を入力します。
      操作手順等は省略します。
      K
      2
      3 =FIND("W",E3)
      • シート上の表示は以下のようにエラーになります。
        「W」を含むものは数値が返るので、この数式で抽出は可能です。
        K
        2
        3 #VALUE!
    • Sub Adfilter4()
        Dim lrow As Long
        '検索条件をセルに入力
        Range("K2").Value = ""
        Range("K3").Value = "=FIND(""W"",E3)"

        'データの抽出先をクリアする
        lrow = Range("B" & Rows.Count).End(xlUp)
        If lrow > 25 Then
          Range("B25:H" & lrow).ClearContents
        End If
        'フィルタオプションの設定でデータ抽出
        Range("B2:H19").AdvancedFilter _
           Action:=xlFilterCopy, _
           CriteriaRange:=Range("K2:K3"), _
           CopyToRange:=Range("B25"), _
           Unique:=False
      End Sub

問題3の解答例    topへ

  1. コードの例1
    • 抽出条件をK2:L3に以下のように入力します。
      • これは完全一致で検索するためです。
      • 「岡田」と入力すると前方一致で検索されます。
      K L
      2 担当者 売上金額
      3 ="=岡田" ="<" & AVERAGE(H3:H19)
      • シート上の表示は以下のようになります。
        K L
        2 担当者 売上金額
        3 =岡田 <110529.411764706
    • Sub Adfilter5()
        Dim lrow As Long
        '検索条件をセルに入力
        Range("K2").Value = "担当者"
        Range("K3").Formula = "=""=岡田"""
        Range("L2").Value = "売上金額"
        Range("L3").Formula = "=""<"" & AVERAGE(H3:H19)"

        'データの抽出先をクリアする
        lrow = Range("B" & Rows.Count).End(xlUp)
        If lrow > 25 Then
          Range("B25:H" & lrow).ClearContents
        End If
        'フィルタオプションの設定でデータ抽出
        Range("B2:H19").AdvancedFilter _
           Action:=xlFilterCopy, _
           CriteriaRange:=Range("K2:K3"), _
           CopyToRange:=Range("B25"), _
           Unique:=False
      End Sub
  2. 検索条件を数式で書くこともできます。
    • K2セルは空欄のままにします。もしくは、列見出しと重複しない文字列を入力します。
      操作手順等は省略します。
      • AVERAGE関数の引数(セル範囲)は絶対参照とします。
      K
      2
      3 =AND(D3="岡田",H3<AVERAGE($H$3:$H$19))
    • Sub Adfilter6()
        Dim lrow As Long
        '検索条件をセルに入力
        Range("K2").Value = "担当者"
        Range("K3").Formula = "=AND(D3=""岡田"",H3<AVERAGE($H$3:$H$19))"
        'データの抽出先をクリアする
        lrow = Range("B" & Rows.Count).End(xlUp)
        If lrow > 25 Then
          Range("B25:H" & lrow).ClearContents
        End If
        'フィルタオプションの設定でデータ抽出
        Range("B2:H19").AdvancedFilter _
           Action:=xlFilterCopy, _
           CriteriaRange:=Range("K2:K3"), _
           CopyToRange:=Range("B25"), _
           Unique:=False
      End Sub

スポンサードリンク



よねさんのExcelとWordの使い方エクセル練習問題:目次|フィルターオプションの設定(VBA)