VBAで複数条件の検索結果を取得したい

質問

ExcelのVBAで複数条件の検索をおこない、出てきた結果を変数に入れて
操作をおこないたいです。
findでは複数条件はできないようですが、ループでセルの検索をおこなって
if文で見ていくしか方法はないのでしょうか。
advancedfilterも調べてみましたが、検索結果を取得する方法がわかりませんでした。
アドバイスをお願いいたします。

・Excelデータ
名前、住所、年齢、性別
田中、東京都、20、男
佐藤、北海道、30、男
渡辺、東京都、20、女

・検索条件
住所：東京都
かつ（and）
年齢：20

・検索結果
田中、東京都、20、男
渡辺、東京都、20、女

となった場合、上記検索結果を変数に入れて操作したいです。

※各項目はExcelの各列に入っています。

回答No.3

kagakusuki · ベストアンサー

オートフィルターで行を抽出した後、SpecialCellsメソッドのxlCellTypeVisibleタイプを利用して表示されている行のセルのみから成る縦一列のセル範囲を設定し、そのセル範囲に対してFor～Each～in～Nextを使用して、各行ごとのデータの取得&配列変数に格納を行う様にすれば良いと思います。

Sub QNo8971372_VBAで複数条件の検索結果を取得したい()

Dim RowF, RowL, myColumns, i, TempNo As Long
Dim ColumnF, ColumnL, NameC, s As String
Dim myCriteria(1, 2), myArray() As Variant
Dim c, myRange As Range

RowF = 2 '項目欄の行番号
ColumnF = "A" '表の左端の列
ColumnL = "D" '表の右端の列
NameC = "A" '氏名が入力されている列
myCriteria(0, 0) = "B" '条件その1となるデータが入力されている列
myCriteria(0, 1) = "東京都" '条件その1となる値
myCriteria(1, 0) = "C" '条件その2となるデータが入力されている列
myCriteria(1, 1) = 20 '条件その2となる値
myCriteria(0, 2) = Columns(ColumnF & ":" & myCriteria(0, 0)).Columns.Count 'AutofilterのFieldの値その1
myCriteria(1, 2) = Columns(ColumnF & ":" & myCriteria(1, 0)).Columns.Count 'AutofilterのFieldの値その2
RowL = Range(NameC & RowS.Count).End(xlUp).Row '氏名が入力されている最終行

If RowL <= RowF Then
MsgBox "データがありません。" & Chr(13) & "マクロを終了します。", _
vbExclamation, "データ無し"
Exit Sub
End If

Application.ScreenUpdating = False 'モニター表示の更新停止

'Autofilterを使って条件を満たす行のみを抽出
With Range(ColumnF & RowF & ":" & ColumnL & RowL)
.AutoFilter Field:=myCriteria(0, 2), Criteria1:=myCriteria(0, 1)
.AutoFilter Field:=myCriteria(1, 2), Criteria1:=myCriteria(1, 1)
End With

myColumns = Columns(ColumnL).Column - Columns(ColumnF).Column '配列変数の第2次元の要素数の決定(表の列数-1)
TempNo = WorksheetFunction.Subtotal(3, Range(myCriteria(0, 0) & RowF + 1 & ":" & myCriteria(0, 0) & RowL)) - 1
'↑Autofilterで抽出さた行数(項目欄の行は除く)を取得(TempNoは数値を一時的に格納するための変数)
ReDim Preserve myArray(TempNo, myColumns) '動的配列変数myArray()の要素数を定義
Set myRange = Range(ColumnF & RowF + 1 & ":" & ColumnF & RowL).SpecialCells(xlCellTypeVisible)
'↑表の左端の列の中でAutofilterで抽出されているセルのみからなるセル範囲を設定

'Autofilterで抽出されたセルのデータを配列変数myArray()に格納
TempNo = 0
For Each c In myRange
For i = 0 To myColumns
myArray(TempNo, i) = c.Offset(0, i).Value
Next i
TempNo = TempNo + 1
Next c

Selection.AutoFilter 'Autofilter解除
Application.ScreenUpdating = True 'モニター表示の更新を許可

'配列変数に格納したデータをダイアログボックス上に表示(この部分は目で確認するためであって必ずしも必要ではない)
For i = 0 To UBound(myArray, 1)
s = s & Chr(13) & myArray(i, 0) & " " & myArray(i, 1) & " " & myArray(i, 2) & " " & myArray(i, 3)
Next i
MsgBox s, vbInformation, "抽出結果"

End Sub

【参考URL】
　質問No.1227176 オートフィルタ使用時のマクロによるセルの移動 【OKWave】
　　http://okwave.jp/qa/q1227176.html

お礼

お礼が遅くなりすみません。
参考にさせていただきました。

回答No.2

noname#217196

オートフィルタでできる範囲に思うけど、ヘルプファイルを引いてごらん。オートフィルタでできることを確認したら、マクロ記録させて、そのマクロを編集するのが簡便。
VBAにこだわらなければ、項目数が少ないならワークシートをデータソースに指定してSQLでレコード抽出。項目数が多ければ、MS Accessからエクセルのワークシートをリンクテーブル指定してSQLでレコード抽出が、ウィザード利用で楽。

お礼

お礼が遅くなりすみません。
参考にさせていただきました。

回答No.1

FEX2053

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_advancedfilter.html

検索結果は「別シートに出せばオッケー」です。
抽出した別シートは「抽出結果だけ」のシートになってますので、
上から順に取得すればオッケー、あとはいじり放題です。

お礼

お礼が遅くなりすみません。
参考にさせていただきました。