2次元配列をフィルターする_VBAで

2次元配列を指定した列・文字でフィルターしてみます。
複雑なフィルター条件するなら、シート上で処理した方が簡単にできると思いますが。
一度配列にデータを入れて、何かの条件でフィルターして、それをまた続けて処理とかする時に、シートに書き出さずに配列のままで出来たらいいなあと思ってやってみました！

新しいエクセルであれば、ワークシートのFILTER関数というのが使えて、これがよさそう。
（職場のPCはエクセル2019。。。）

配列をフィルターする関数

• 処理中に配列の行列を逆にしているのでCall 行列の入替え(filterArray)でそれを戻している
• 行列の入替えについてはこちらの記事

Private Function 配列をフィルター(myArray, filterCol As Long, filterKey As String, Optional titleFlag As Boolean = False)

    Dim filterArray
    Dim tmpMinRow As Long
    Dim tmpMaxRow As Long
    Dim tmpMinCol As Long
    Dim tmpMaxCol As Long
    Dim i As Long
    Dim j As Long
    Dim skipRow As Long
    
    tmpMinRow = LBound(myArray, 2)
    tmpMaxRow = UBound(myArray, 2)
    tmpMinCol = LBound(myArray, 1)
    tmpMaxCol = LBound(myArray, 1)
    
    '縦横を入れ替えた配列　フィルターして残すものを追加していく
    ReDim filterArray(tmpMinRow To tmpMaxRow, tmpMinCol To tmpMaxCol)
    tmpMaxCol = tmpMaxCol - 1
    
    'タイトルを含めるかどうかの処理
    If titleFlag Then
        tmpMaxCol = tmpMaxCol + 1
        ReDim Preserve filterArray(tmpMinRow To tmpMaxRow, tmpMinCol To tmpMaxCol)
        For j = LBound(myArray, 2) To UBound(myArray, 2)
            
            filterArray(j, tmpMaxCol) = myArray(LBound(myArray, 1), j)
        Next
        'タイトル行分をループ処理に含むかどうか
        skipRow = 1
    End If

    '対象列がフィルター対象だったら一時配列に追加していく
    For i = LBound(myArray, 1) + skipRow To UBound(myArray, 1)
        
        If myArray(i, filterCol) Like filterKey Then
            
            tmpMaxCol = tmpMaxCol + 1
            ReDim Preserve filterArray(tmpMinRow To tmpMaxRow, tmpMinCol To tmpMaxCol)
            For j = LBound(myArray, 2) To UBound(myArray, 2)
                filterArray(j, tmpMaxCol) = myArray(i, j)
            Next
            
        End If
    Next

    Call 行列の入替え(filterArray)
    配列をフィルター = filterArray

End Function

引数の説明

• myArray　対象とする2次元配列

• filterCol　フィルター対象とする列

• filterKey　フィルターする文字列
  条件の所を、if ~ like としているのでワイルドカードも可

• titleFlag　配列の一行目がタイトルかどうか
  規定値はfalse
  trueにすると一行目はフィルター対象外として必ず含める

  戻り値の説明

• フィルターした結果を2次元配列で返す

• 条件に当てはまるのがなかったら空の配列が返される（エラーにはならない）
  titleFlagをtrueにしていたらタイトルだけの配列が返される

  使用する

• 元表シートにある表から、2列目で"文字文字"でフィルターする

• 一行目はタイトルとして残す

• 結果はフィルターシートに書き出される

Sub main()

    Dim myArray
    
    myArray = ThisWorkbook.Worksheets("元表").Range("A1").CurrentRegion
    
    myArray = 配列をフィルター(myArray, 2, "文字文字", True)
    
    With ThisWorkbook.Worksheets("フィルター").Range("A1")
        
        .CurrentRegion.ClearContents
        .Resize(UBound(myArray, 1), UBound(myArray, 2)) = myArray
        
    End With
    
End Sub