VBA Filter関数入門｜1次元配列・2次元配列の活用術

Sub FilterBasicExample()
    Dim fruits As Variant
    Dim result As Variant
    Dim i As Long

    '// 配列を定義
    fruits = Array("リンゴ", "ミカン", "バナナ", "パイナップル", "ブドウ")

    '// "パイ"を含む要素を抽出
    result = Filter(fruits, "パイ")
    
    '// 抽出結果をメッセージボックスで表示
    For i = LBound(result) To UBound(result)
        Debug.Print result(i)
    Next i

End Sub

Sub FilterWithCaseSensitivity()
    Dim fruits As Variant
    Dim result As Variant
    Dim i As Long

    '// 配列を定義
    fruits = Array("Apple", "apple", "APPLE", "Banana")

    '// "apple" を抽出（大文字小文字を区別）
    result = Filter(fruits, "apple", True, vbBinaryCompare)

    '// 抽出結果をメッセージボックスで表示
    For i = LBound(result) To UBound(result)
        Debug.Print result(i)
    Next i
End Sub

Sub FilterWithoutCaseSensitivity()
    Dim fruits As Variant
    Dim result As Variant
    Dim i As Integer

    '// 配列を定義
    fruits = Array("Apple", "apple", "APPLE", "Banana")

    '// "apple" を抽出（大文字小文字を区別しない）
    result = Filter(fruits, "apple", True, vbTextCompare)

    '// 抽出結果をメッセージボックスで表示
    If Not IsEmpty(result) Then
        For i = LBound(result) To UBound(result)
            MsgBox result(i)
        Next i
    Else
        MsgBox "条件に一致する要素がありませんでした。"
    End If
End Sub

Sub CheckFilterResult()
    Dim myArray As Variant
    Dim result As Variant

    '// 配列を定義
    myArray = Array("リンゴ", "ミカン", "バナナ", "パイナップル", "ブドウ")

    '// "スイカ" を条件として抽出（条件に一致しない要素を想定）
    result = Filter(myArray, "スイカ")

    '// 抽出結果を確認
    On Error Resume Next
    If LBound(result) > UBound(result) Then
        MsgBox "条件に一致する要素が見つかりませんでした。"
    Else
        MsgBox "抽出完了！"
    End If
    On Error GoTo 0
End Sub

Sub Filter2DArrayInOneProcedure()
    Dim data(1 To 5, 1 To 3) As Variant
    Dim resultArray() As Variant
    Dim tempArray() As Variant
    Dim filterCol As Long
    Dim filterKey As String
    Dim includeTitle As Boolean
    Dim i As Long, j As Long, k As Long
    Dim resultIndex As Long
    Dim minRow As Long, maxRow As Long
    Dim minCol As Long, maxCol As Long

    '// サンプルデータの設定
    data(1, 1) = "商品名": data(1, 2) = "カテゴリ": data(1, 3) = "価格"
    data(2, 1) = "リンゴ": data(2, 2) = "果物": data(2, 3) = 100
    data(3, 1) = "バナナ": data(3, 2) = "果物": data(3, 3) = 150
    data(4, 1) = "にんじん": data(4, 2) = "野菜": data(4, 3) = 80
    data(5, 1) = "オレンジ": data(5, 2) = "果物": data(5, 3) = 120

    '// フィルター条件の設定
    filterCol = 2               '// フィルター対象列（カテゴリ）
    filterKey = "果物"          '// フィルター条件
    includeTitle = True         '// タイトル行を含む場合はTrue

    '// 入力配列の境界を取得
    minRow = LBound(data, 1)
    maxRow = UBound(data, 1)
    minCol = LBound(data, 2)
    maxCol = UBound(data, 2)

    '// 結果配列の初期化
    ReDim resultArray(1 To 1, minCol To maxCol)
    resultIndex = 0

    '// タイトル行を含める場合
    If includeTitle Then
        resultIndex = resultIndex + 1
        For j = minCol To maxCol
            resultArray(1, j) = data(minRow, j)
        Next j
    End If

    '// フィルタリング処理
    For i = minRow + IIf(includeTitle, 1, 0) To maxRow
        If data(i, filterCol) Like filterKey Then
            '// 一時配列で行を追加
            resultIndex = resultIndex + 1
            ReDim tempArray(1 To resultIndex, minCol To maxCol)
            
            '// 元の結果を一時配列にコピー
            For j = minCol To maxCol
                If resultIndex > 1 Then
                    For k = 1 To resultIndex - 1
                        tempArray(k, j) = resultArray(k, j)
                    Next k
                End If
                '// 現在の行をコピー
                tempArray(resultIndex, j) = data(i, j)
            Next j

            '// 一時配列を結果配列に再コピー
            ReDim resultArray(1 To resultIndex, minCol To maxCol)
            For k = 1 To resultIndex
                For j = minCol To maxCol
                    resultArray(k, j) = tempArray(k, j)
                Next j
            Next k
        End If
    Next i

    '// 結果の表示
    If resultIndex = 0 Then
        Debug.Print "条件に一致するデータがありません。"
    Else
        For i = LBound(resultArray, 1) To UBound(resultArray, 1)
            For j = LBound(resultArray, 2) To UBound(resultArray, 2)
                Debug.Print resultArray(i, j);
            Next j
            Debug.Print
        Next i
    End If
End Sub

Sub CountStringFrequency()
    Dim fruits As Variant
    Dim result As Variant
    Dim count As Long

    '// 配列を定義
    fruits = Array("リンゴ", "ミカン", "リンゴ", "バナナ", "リンゴ", "ブドウ")

    '// "リンゴ"を含む要素を抽出
    result = Filter(fruits, "リンゴ")

    '// 抽出結果の要素数をカウント
    If Not IsEmpty(result) Then
        count = UBound(result) - LBound(result) + 1
        MsgBox "配列内の「リンゴ」の数は " & count & " 個です。", vbInformation
    Else
        MsgBox "配列内に「リンゴ」は含まれていません。", vbExclamation
    End If
End Sub

Sub FilterMultipleConditions()
    Dim fruits As Variant
    Dim result As Variant
    Dim i As Long
    Dim keywords As Variant
    Dim combinedResult As Collection

    '// 配列を定義
    fruits = Array("リンゴ", "ミカン", "バナナ", "パイナップル", "リンゴ", "バナナ", "ブドウ")

    '// 条件となるキーワードを定義
    keywords = Array("リン", "ナナ")
    Set combinedResult = New Collection

    '// 各キーワードでフィルタリング
    For i = LBound(keywords) To UBound(keywords)
        result = Filter(fruits, keywords(i))
        If Not IsEmpty(result) Then
            Dim j As Long
            For j = LBound(result) To UBound(result)
                On Error Resume Next '// 重複を防ぐ
                combinedResult.Add result(j), CStr(result(j))
                On Error GoTo 0
            Next j
        End If
    Next i

    '// 結果を表示
    If combinedResult.count > 0 Then
        For i = 1 To combinedResult.count
            Debug.Print combinedResult(i)
        Next i
    Else
        Debug.Print "条件に一致する要素がありませんでした。"
    End If
End Sub

Sub GetExcludedRowNumbers()
    Dim fruits As Variant
    Dim excludedRows() As Long
    Dim i As Long, count As Long

    '// 配列を定義
    fruits = Array("リンゴ", "ミカン", "バナナ", "パイナップル", "ブドウ")

    '// 行番号を取得
    count = 0
    For i = LBound(fruits) To UBound(fruits)
        If fruits(i) <> "バナナ" Then '// "バナナ"以外の要素をチェック
            count = count + 1
            ReDim Preserve excludedRows(1 To count)
            excludedRows(count) = i + 1 ' 行番号を格納（1始まり）
        End If
    Next i

    '// 結果を表示
    If count > 0 Then
        For i = 1 To count
            Debug.Print "行番号: " & excludedRows(i)
        Next i
    Else
        Debug.Print "条件に一致する要素がありませんでした。"
    End If
End Sub