エクセルの検索・抽出マクロについて教えて下さい。

質問

急遽、会社のマクロ使用可のパソコン（ヴィスタ）で、
検索・抽出のデータ作業をすることになりました。

オートフィルタの貼り付けでは、時間がかかりすぎるということで、
職場の少ない知恵を出し合って考えていますが、なかなか上手くいかず、こちらにも お尋ねさせていただきます。

シート1に、３列（番号、文字、英字）の 『参照データ』があります。

シート２の 『検索する番号』 に番号を入れ、

『検索開始』ボタンを押すと、

シート１の『参照データ』から抽出されたデータが、
シート２に 『検索後のデータ』として表になって出てくるような関数（の場合はボタンなし）か、マクロをつくりたいのですが・・

更には
シート２の『検索する番号』を、番号ではなく
表の真ん中の列の『文字』でも検索できるように（番号でも文字でも、どちらでも検索できるように・・）は出来ないでしょうか・・・

ご回答を、心から お待ちしております！
よろしく お願いします （u＿u）

回答No.2

tom04 · ベストアンサー

補足を読ませていただきました。

＞文字が・・・・『検索する文字を含む』でした

ということなので、前回同様にコードを作ってみると・・・　（￣□￣）がーん

仮に元データ内に「あいう」・「いえ」等々があり、検索文字が「あ」・「い」のように二つ以上含まれていると
すべて重複して表示されてしまいましたので、
今回はG列を作業用の列として使い、重複を削除しています。
（もしG列以降にデータがあるのであればコードが少し変わってきます）

Private Sub CommandButton1_Click()
Dim i, j, k As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
k = ws2.Cells(Rows.Count, 4).End(xlUp).Row
If k > 3 Then
Range(ws2.Cells(4, 4), ws2.Cells(k, 6)).ClearContents
ws2.Columns("D:F").Interior.ColorIndex = xlNone
End If
If ws2.Cells(Rows.Count, 2).End(xlUp).Row > 3 Then
If IsNumeric(ws2.Cells(4, 2)) Then
k = 2
ElseIf WorksheetFunction.CountIf(ws1.Columns(3), "*" & ws2.Cells(4, 2) & "*") Then
k = 3
Else
k = 4
End If
For i = 4 To ws1.Cells(Rows.Count, 2).End(xlUp).Row
For j = 4 To ws2.Cells(Rows.Count, 2).End(xlUp).Row
If k = 2 Then
If ws1.Cells(i, k) = ws2.Cells(j, 2) Then
With ws2.Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Value = ws1.Cells(i, 2)
.Offset(, 1) = ws1.Cells(i, 3)
.Offset(, 2) = ws1.Cells(i, 4)
End With
End If
Else
If ws1.Cells(i, k) Like "*" & ws2.Cells(j, 2) & "*" Then
With ws2.Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Value = ws1.Cells(i, 2)
.Offset(, 1) = ws1.Cells(i, 3)
.Offset(, 2) = ws1.Cells(i, 4)
End With
End If
End If
Next j
Next i
For j = 4 To ws2.Cells(Rows.Count, 4).End(xlUp).Row
ws2.Cells(j, 7) = ws2.Cells(j, 4) & ws2.Cells(j, 5) & ws2.Cells(j, 6)
Next j
For j = ws2.Cells(Rows.Count, 7).End(xlUp).Row To 4 Step -1
If WorksheetFunction.CountIf(Range(ws2.Cells(4, 7), ws2.Cells(j, 7)), ws2.Cells(j, 7)) > 1 Then
Range(ws2.Cells(j, 4), ws2.Cells(j, 7)).Delete (xlUp)
End If
Next j
End If
ws2.Columns(7).Delete
For j = 4 To ws2.Cells(Rows.Count, 4).End(xlUp).Row
If WorksheetFunction.CountIf(ws2.Columns(4), ws2.Cells(j, 4)) > 1 Then
Range(ws2.Cells(j, 4), ws2.Cells(j, 6)).Interior.ColorIndex = 36 '←色は好みで変更
End If
Next j
End Sub

こんなんではどうでしょうか？
今回もSheet2の検索文字列は統一している（Sheet1のB～D列が混在しない）ものとし、
必ずB列の4行目（最初の行）から検索文字は入っているという前提です。
尚、For～Nextを多用していますので、表示されるまで結構時間がかかるかもしれません。

じっくり考えればもっと簡単なコードになるかもしれませんが、
今回はこの程度で・・・m(__)m

お礼

わーい、出ました！
本当に凄いです！　完璧です！

tom04さん（＾▽＾）こんにちは。

難しいマクロを
時間をかけて　考えていただいたにもかかわらず、
私の不注意で、再度　作り直していただき・・・（；＿；）涙・・・
感謝でいっぱいです。

時間のかかる作業を、一瞬でできるように　叶えていただいて、
心から、ありがとうございました☆

今から、ご回答（１）のマクロとの違いを勉強してきます♪

回答No.1

tom04

こんばんは！
一例です。

＞表の真ん中の列の『文字』でも検索できるように（番号でも文字でも、どちらでも検索できるように・・）
とありますので、勝手に「英字」でも検索できるようにしてみました。

尚、Sheet2の検索列は「番号」なら「番号」のみ、「文字」なら「文字」のみという具合に
Sheet1のB～D列のデータが混在していないという前提です。
（3・い・F　のように他の列の物が混ざっていない）
尚、重複するものに色を付けるということですが、「番号」が重複する場合のみ薄い黄色にするようにしています。
（他の列「文字」・「英字」に重複があっても「番号」のみが色付け対象です）
画像を拝見するとコマンドボタンを配置されているようなので、デザインモードでコマンドボタンをダブルクリックし↓のコードをコピー＆ペーストしてみてください。
当然のことながらダブルクリック時点で1行目と最終行は入っているはずですので必要ありません。

Private Sub CommandButton1_Click()
Dim i, j, k As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
k = ws2.Cells(Rows.Count, 4).End(xlUp).Row
If k > 3 Then
Range(ws2.Cells(4, 4), ws2.Cells(k, 6)).ClearContents
ws2.Columns("D:F").Interior.ColorIndex = xlNone
End If
j = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If j > 3 Then
If WorksheetFunction.CountIf(ws1.Columns(2), ws2.Cells(4, 2)) Then
k = 2
ElseIf WorksheetFunction.CountIf(ws1.Columns(3), ws2.Cells(4, 2)) Then
k = 3
Else
k = 4
End If
End If
For i = 4 To ws1.Cells(Rows.Count, 2).End(xlUp).Row
For j = 4 To ws2.Cells(Rows.Count, 2).End(xlUp).Row
If ws1.Cells(i, k) = ws2.Cells(j, 2) Then
With ws2.Cells(Rows.Count, 4).End(xlUp).Offset(1)
.Value = ws1.Cells(i, 2)
.Offset(, 1) = ws1.Cells(i, 3)
.Offset(, 2) = ws1.Cells(i, 4)
End With
End If
Next j
Next i
For j = 4 To ws2.Cells(Rows.Count, 4).End(xlUp).Row
If WorksheetFunction.CountIf(ws2.Columns(4), ws2.Cells(j, 4)) > 1 Then
Range(ws2.Cells(j, 4), ws2.Cells(j, 6)).Interior.ColorIndex = 36 '←色は好みで変更
End If
Next j
End Sub

こんな感じではどうでしょうか？m(__)m

お礼

tom04さん、こんばんは（＾▽＾）

いつも　いつも、早くに
貴重なお時間をさいて　考えていただき、
ありがとうございます！

早速　コピーしてボタンを押しみました。

すごい！（≧▽≦）人　パチパチパチ
一瞬で表が現れました。
最高です、会社のみんなの、驚きと　喜ぶ顔が目に浮かびます♪

今から、教えて頂いたマクロの解読・・・
勉強させていただきます！

本当に　いつも、朝から晩まで、感謝感激して止みません　（=＾▽＾=)

補足

tom04さん　（・▽・）こんばんは！
只今、教えていただいたマクロを　勉強中ですが・・・

なんと、申し訳ないことに、
深いご配慮で　数字でも文字でも英字でも検索できるようにしていただきましたのに、
私の説明間違いに　気づきました（￣□￣）がーん　なんで気づかんかったんじゃろー
本当に　すみません・・・

検索時に、数字（番号）は完全一致なのですが、
文字が・・・・『検索する文字を含む』でした　（；＿；）

例）参照データの文字が『あああ』で、検索の文字が『あ』の場合がありました。

教えて頂いたマクロの、どの部分を　どのように変えたら実行できますでしょうか？

説明不足を、おゆるしください。

いつまででもお待ちしておりますので
どうか、ご指導を、よろしくお願い致します！