Excel フィルタオプション マクロ

質問

＜Excel2013＞
フィルタオプションで抽出条件を加工し
別シート(抽出結果）に抽出したい。
検索条件で「文字を含む」の場合「＝”＝＊"」など
抽出記号入力するのが分からない人の為に、
検索したい文字だけ入力してVBAで加工して
データを抽出したいのですが、上手く加工出来ません。
どうかお知恵をお貸し下さい！

◎例題（実際は1000件位横に広いデータです）
【シート名：青森】
住所　　　　　　　　　　　　処理No.　　　　
青森県青森市南町・・・　　　10
　・
青森県五所川原市北町　　　　10

【シート名：秋田】
住所　　　　　　　　　　　　処理No.　　　　
秋田県大館市北町・・・　　　20
　・
秋田県秋田市栄町・・・　　　10

【シート名：抽出結果】
　　　　　Ｃ2　　　　　　Ｄ2　　　　F2　　　　　　G2
検索条件　抽出シート　　住所　　　　抽出シート　　住所
　　　　　秋田　　　 栄　　　　　　　　　　　　　
＜抽出実行ボタン押下＞

★検索条件：シート＝秋田　and 住所に『栄』を含むデータを抽出
同シート【Ａ7セル】を基準に抽出データを表示

Sub 抽出()
Dim Sh As Worksheet
’*
Set Sh = Sheets("抽出結果")
Sh.Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).Select
'
Sh.Range("A7").Select

★検索条件範囲：E2／F２へ加工した条件を設定　
'** 抽出条件
If Sh.Range("C2").Value <> "" Then
Sh.Range("F2").Value = "=” & Sh.Range("C2").Value
End If
If Sh.Range("D2").Value <> "" Then
Sh.Range("G2").Value = "=”&"=＊" & Sh.Range("D2").Value & "＊"
End If
’*
Select Case Range("C2").Value
Case "青森"
Sheets("青森").Range("1:cx2000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False
Case "秋田"
Sheets("秋田").Range("1:Cx2000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False
End Select
End Sub

回答No.1

ushi2015

こんにちは

セル位置がイマイチ分からないですけど、
Sub 抽出()
　　Dim Sh As Worksheet
　　'*
　　Set Sh = Sheets("抽出結果")
　　'** 抽出条件
　　With Sh
　　　　If .Range("C2").Value <> "" Then
　　　　　　.Range("F2").Value = "=""" & .Range("C2").Value & """"
　　　　End If
　　　　If .Range("D2").Value <> "" Then
　　　　　　.Range("G2").Value = "=" & """*" & Sh.Range("D2").Value & "*"""
　　　　End If

　　　　Sheets(.Range("C2").Value).Range("A1:CX2000").AdvancedFilter Action:=xlFilterCopy, _
　　　　　　CriteriaRange:=.Range("G1:G2"), CopyToRange:=.Range("A7"), Unique:=False

　　End With
End Sub
でしょうか？

抽出結果シートのセルA7には「処理No.」と入っているのですよね？

お礼

御礼のメール遅くなりました．．
ご回答有難うございました。
うまく抽出出来ました！
しかし、下記のように『”＝”』が不足して
いたので追加しました。
尚、質問事項のセル位置が分かりずらくて
すみませんでした。

If .Range("C2").Value <> "" Then
　.Range("F2").Value = "=""" & "=" &.Range("C2").Value & """"
End If
If .Range("D2").Value <> "" Then
　.Range("G2").Value = "=" & """=*" & Sh.Range("D2").Value & "*"""
End If