（エクセル）複数の検索ワードから検索し転記する。

質問

（エクセル） 複数の条件にあうレコードを検索し転記する方法を教えてください。
会社で加工履歴を入力し、それを加工のデーターベース及び、単価表としても使用しようと考えています。

以前は、部品コードを入力すると、VLOOKUPで別シートにある一覧から部品コードを検索し、その型式・部品名・金額・処理を出せるようにしていたのですが、同じ部品コードで違う処理加工をするケースが存在し、VLOOKUPでは先頭の１つのみしか結果が出せない為、手入力で行っていたのですが、手入力の際、そこのセルの数式が飛んでしまい、使いやすいのか使いにくいのかわからない状態でした。

そこで、部品コードと行った処理（合計4セル）から一致するものを検索し、言い換えれば、写真下段の加工フォームの様に、Ｃ４・Ｃ５・Ｄ５・Ｅ５の４種から一致するレコードを検索し、写真上段の一覧からその結果をＣ７・Ｅ７・Ｃ８に挿入すればいいのかと思い、色々とマクロを組んでみましたが、一向に作動しません。

このようなケースの場合、どういったマクロを組めばいいのでしょうか？

どなたか、御教授願います。

回答No.3

tom04 · ベストアンサー

こんばんは！
万一該当データが複数ある場合は最初の行のデータだけでよいのでしょうか？

そういうコトだとしての一例です。
元データはSheet1にあり、コマンドボタンはSheet2にあるとします。
Sheet3を作業用のSheetとして使用していますので、Sheet3は全く使用していないSheetにしてください。
オートフィルタでやってみました。

Private Sub CommandButton1_Click()
Dim i As Long, wS1 As Worksheet, ws3 As Worksheet
Set wS1 = Worksheets("Sheet1") '←Sheet1は実際のSheet名に！
Set ws3 = Worksheets("Sheet3") '←作業用Sheet
Application.ScreenUpdating = False
With wS1.Range("A1")
.AutoFilter field:=1, Criteria1:=Range("C4")
.AutoFilter field:=4, Criteria1:=Range("C5")
.AutoFilter field:=5, Criteria1:=Range("D5")
.AutoFilter field:=6, Criteria1:=Range("E5")
End With
i = wS1.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
wS1.Cells(1, 1).CurrentRegion.Copy ws3.Cells(1, 1)
With Range("C7")
.Value = ws3.Cells(2, 2)
.Offset(, 2) = ws3.Cells(2, 3)
.Offset(1) = ws3.Cells(2, 7)
End With
Else
MsgBox "該当データなし"
End If
ws3.Cells.Clear
wS1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

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

お礼

遅くなりました。有難う御座いました。
おかげで解決しました。

一番先に回答をくれた方をベストアンサーとさせて頂きます。

回答No.2

mt2008

加工履歴のシートに部品コードと処理1から3を合体させた検索用文字列を表示する作業列を追加してしまえばマクロを使わなくてもVLOOKUP関数で出来ますよ。
作業列を見せたくないなら非表示にすれば良いです。

回答No.1

KURUMITO

元の一覧表がシート1に有るとして写真下段の表がシート2にあるとします。
シート2で「開発」タブの「挿入」からActiveXコントロールのコマンドボタンをクリックしてシート上に四角を描くようにしてボタンを設置します。
右クリックして「コードの表示」を選択して表示の画面には次のコードを入力します。

Private Sub CommandButton1_Click()
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
Dim i As Long
i = 1
Do
i = i + 1
If WS1.Cells(i, "A").Value = WS2.Range("C4").Value And WS1.Cells(i, "D").Value = WS2.Range("C5") _
And WS1.Cells(i, "E").Value = WS2.Range("D5").Value And WS1.Cells(i, "F").Value = WS2.Range("E5").Value Then
WS2.Range("C7") = WS1.Cells(i, "B").Value
WS2.Range("E7") = WS1.Cells(i, "C").Value
WS2.Range("C8") = WS1.Cells(i, "G").Value
End If
Loop Until WS1.Cells(i, "A") = ""
End Sub

部品コードと処理のセルに入力したのちにコマンドボタンをクリックすれば形式、部品名、金額が表示されます。

補足

＞ＫＵＲＵＭＩＴＯさん

　早速の回答有難うございます。
　早速試してみましたが、Ｃ８に”０”と表示している結果でした？
　何故でしょうか？
　お分かりになりましたら、御教授下さい。
　私も色々と試してみます。