2種の検索をかけて一致する場合にその値をかえす

質問

エクセルvbaにおいて教えていただけないでしょうか。
課題は添付のようなものです。
転機元のシートは売り上げデータ
転機先のシートは年間実績です。
シート売り上げデータの項目１行目にかかれている 名前と一致した場合に、売り上げデータの実績４月を年間実績シートの4月へ、（赤枠）、予定は同様に5月へ（青枠） へ
入力していきたいのです。

＜条件＞
・売り上げデータシートのA列の名前と年間実績A列の名前が 一致した場合であり、なおかつ売り上げデータシートの「中間予想値」「実績値」の２項目を、年間実績シートの「本部設定値」「個人設定値」「中間予想値」「実績値」の４項目の中で検索させて「中間予想値」「実績値」それぞれ一致した行に入力する、という命令をさせたい。
例：田中さんの４月実績値5,500円・5月中間予想値４５００円を、年間実績の田中とかかれた4月の「実績値」行と５月の「中間予想値」行とそれぞれに入力させたい。
・年間実績シートには、営業１～２課、３～７課など、ランダムなくくりでSUM関数の入った小計がある。
・転記先の列の指定はメッセージボックスをつかって「予定を入れたい月を指定してください」→4月入力、
「実績を入れたい月を指定してください」
→5月入力
という形でその都度自分で修正（指定）したい。
以上、難しい処理で申し訳ございません。
知恵をかしていただければ幸いです。
転機元シートはいくらでも編集できますので転機元シートをこのように編集してください、という条件は可能です。転機先シートは他人のファイルでいじることができません。

恐れ入りますがよろしくお願いします。

回答No.4

kkkkkm · ベストアンサー

No2の訂正です。

年間実績の月は右に3月まであるみたいなのを見逃してました。
一応R列までとして3月は実績だけを転記するようにしました。
途中小計項目とかあっても項目が1から12の数値でなければ飛ばして該当月に転記します。
必ず中間予想値より下に実績値があると考えてます。

Sub Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mRange As Range, mRange2 As Range
Dim i As Long, j As Long
Dim mMonth As Long, mMonth2 As Long, tmp As Variant

Set Ws1 = Sheets("売り上げデータ")
Set Ws2 = Sheets("年間実績")

tmp = InputBox("実績を入れたい月を指定してください" & vbCrLf & vbCrLf & "1～12の数値", "指定月入力")
If tmp = "" Then
MsgBox "未入力で終了します"
Exit Sub
End If
If IsNumeric(tmp) Then
mMonth = Val(tmp)
Else
MsgBox "数値以外が入力されました"
Exit Sub
End If
If mMonth < 1 Or mMonth > 12 Then
MsgBox "範囲外です"
Exit Sub
End If
Set mRange = Ws2.Range("D2:R2").Find(mMonth, LookIn:=xlValues, LookAt:=xlWhole)
If mRange Is Nothing Then
MsgBox "指定した月の転記先がありません", vbCritical
Exit Sub
End If
mMonth2 = Month(DateAdd("m", 1, Year(Date) & "/" & mMonth & "/" & 1))
Set mRange2 = Ws2.Range("D2:R2").Find(mMonth2, LookIn:=xlValues, LookAt:=xlWhole)
If mRange2 Is Nothing Then
MsgBox "指定した翌月の転記先がありません", vbCritical
Exit Sub
End If
For i = 1 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Ws2.Cells(Rows.Count, "A").End(xlUp).Row
If Ws1.Cells(i, "A").Value = Ws2.Cells(j, "A").Value Then
If Ws1.Cells(3, "D").Value = Ws2.Cells(j, "C").Value Then
Ws2.Cells(j, mRange.Column).Value = Ws1.Cells(i, "D").Value
Exit For
ElseIf Ws1.Cells(3, "E").Value = Ws2.Cells(j, "C").Value And _
mMonth <> 3 Then
Ws2.Cells(j, mRange2.Column).Value = Ws1.Cells(i, "E").Value
End If
End If
Next
Next
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

お礼

求めている動きをしてくれました。他のかたがいう、自分で作ることが大切、というのも承知なのですが、無償のレッスンをしてくださるkkk様には今回も本当にお世話になりました。またここから一つ一つの工程が何を意味するか調べていきます。
ありがとうございました。

回答No.6

imogasi

コードを作ってくれ、という、丸投げではないか？
まして、会社の仕事に関するものだろう。業者やシステム担当に教えてもらうのが筋。
画像がぼやケてみにくい。＞転機元－-転記先？
ーー
深くは質問の状況を詮索してないが
（データ例を少数テキストで作って説して、ほしい。）
「今月」シート
名前 項目１ 項目２
佐藤 23 16
山本 123 41
今井 45 52
「年次」シート
名前 １月 1月 ２月　２月・・
佐藤 23 16
木村
近藤
山本 123 41
今井 45 52
コード
Sub test01()
Set sh1 = Worksheets("今月")
Set sh2 = Worksheets("年次")
For i = 2 To 4
x = sh1.Cells(i, "A")
MsgBox x
Set f = sh2.Range("a2:A1000").Find(x)
'MsgBox f.Row
sh2.Cells(f.Row, "B") = sh1.Cells(i, "B")
sh2.Cells(f.Row, "c") = sh1.Cells(i, "C")
Next i
End Sub
のような簡単なことだろう。質問説明も雑で、小生勘違いや、見漏らしている点あるかもしれないが
、骨子はこういうものではないか？
sh2.Cells(f.Row, "B")の列の部分は、毎月変わるかもしれないので、毎月指定か対策は必要。
VLOOKUPのおすすめの回答がでていて、色々言っているが、VBAではFindメソッドだ。どちらも２番目以後の該当は検索しない。MATCH関数も同じ。
自分独自の分派行動するとシステム部には褒められるよりも、睨まれるかもしれない。

お礼

今回も厳しい意見ありがとうございます。まさに正論です。厳しいながらも今後のことを見越してわかるように教育いただいていることが、嬉しく思います。
はい、そのレッスンやってみます。

回答No.5

kon555

>> VLOOKUPでやりたいが〜〜VBAをなんとかくみたいのですが、やり方がわからず悩んで今に至ります。
　なるほど。
　何となくですが、どういう立場で苦労されているのか、お察しします。

　ただ似たような立場も経験した者として、もしもこうした業務が頻繁にあるならば、いっそ貴方自身がvbaを習得する事をお勧めはします。
　正直なところ、貴方の要望する機能を備えたvbaを組む事自体は結構簡単なのですが、複雑さとしては中々の物になるため、何かが変わるとすぐにエラーで使えなくなります。また類似作業にも対応できないモノになります。

　一応参考になる解説系のページを紹介しておきますので、よろしければトライしてみて下さい。簡単なモノが自分で組めるようになるだけで、劇的に楽になります。

基礎的な事項について
https://excel-ubara.com/excelvba1/

条件処理について
https://excel-ubara.com/excelvba1/EXCELVBA320.html

繰り返し処理について
https://valmore.work/excel-vba-for/

類似した案件の例
https://www.mutable.work/entry/search-by-loop

お礼

自分でつくることが大切、たしかにそうです。
今簡単なVBAはここで質問させていただくことでできるようになってきました。
疑問がてできては、このOK webで質問し、勉強しています。
いただいたリンク、早速本日じっくりみてみます。

回答No.3

kkkkkm

No2の補足です。

年間実績シートのC列の
中間予想値
実績値
で必ず中間予想値より下に実績値があるのでしたら

Ws2.Cells(j, mRange.Column).Value = Ws1.Cells(i, "D").Value

のところを

Ws2.Cells(j, mRange.Column).Value = Ws1.Cells(i, "D").Value
Exit For

にしてください。

>> 例：田中さんの４月実績値5,500円・5月中間予想値４５００円を、年間実績の田中とかかれた4月の「実績値」行と５月の「中間予想値」行とそれぞれに入力させたい。
>
> を売り上げデータシートの人数分実行します。

は、指定した月と翌月のセルに書き込むということです。

回答No.2

kkkkkm

> ・転記先の列の指定はメッセージボックスをつかって「予定を入れたい月を指定してください」→4月入力、
> 「実績を入れたい月を指定してください」
> →5月入力

この意味がいまひとつわからないので(売り上げデータシートには4月と5月しかないので)、実績を入れたい月だけ入力するようにしてます。

> 例：田中さんの４月実績値5,500円・5月中間予想値４５００円を、年間実績の田中とかかれた4月の「実績値」行と５月の「中間予想値」行とそれぞれに入力させたい。

を売り上げデータシートの人数分実行します。

年間実績シートの月のセルには月は入れなくて数値だけにしてください。

以下で試してみてください。

Sub Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mRange As Range
Dim i As Long, j As Long
Dim mMonth As Long, tmp As Variant

Set Ws1 = Sheets("売り上げデータ")
Set Ws2 = Sheets("年間実績")

tmp = InputBox("実績を入れたい月を指定してください" & vbCrLf & vbCrLf & "1～12の数値", "指定月入力")
If tmp = "" Then
MsgBox "未入力で終了します"
Exit Sub
End If
If IsNumeric(tmp) Then
mMonth = Val(tmp)
Else
MsgBox "数値以外が入力されました"
Exit Sub
End If
If mMonth < 1 Or mMonth > 12 Then
MsgBox "範囲外です"
Exit Sub
End If
Set mRange = Ws2.Range("D2:F2").Find(mMonth, LookIn:=xlValues, LookAt:=xlWhole)
If mRange Is Nothing Then
MsgBox "指定した月の転記先がありません", vbCritical
Exit Sub
End If
For i = 1 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Ws2.Cells(Rows.Count, "A").End(xlUp).Row
If Ws1.Cells(i, "A").Value = Ws2.Cells(j, "A").Value Then
If Ws1.Cells(3, "D").Value = Ws2.Cells(j, "C").Value Then
Ws2.Cells(j, mRange.Column).Value = Ws1.Cells(i, "D").Value
ElseIf Ws1.Cells(3, "E").Value = Ws2.Cells(j, "C").Value Then
Ws2.Cells(j, mRange.Column + 1).Value = Ws1.Cells(i, "E").Value
End If
End If
Next
Next
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

回答No.1

kon555

VBA不要です。VLOOKUP関数で対応できます。使い方は下記ページを参考にどうぞ。
https://www.pc-koubou.jp/magazine/39639
　使い方はここ以外にも検索すれば大量に出てきますので、貴方にとって分かりやすいページを探してみても良いと思います。

　ちなみに、データ数が大量などでVLOOKUP関数が重たい、などの場合であっても、VBAはお勧めしません。
「転記先シートは他人のファイルでいじることができません。」という事は、VBA側で作り込んだとしても転記先のレイアウトの変更やちょっとした文言変更で使えなくなる可能性が常にあります。
　こうしたケースでは貴方自身が構築できる手法の方がいいです。また「その都度自分で修正（指定）したい」というのも関数であれば容易です。
　またVLOOKUP関数は便利な機能なので、こうしたExcelでのデータ集計などが業務として存在するなら、この機会に覚えおいて損はないと思います。

補足

朝早くに早速のご返信ありがとうございます！！
VLOOKUPをしたいところなのですが、本部通達と個人設定にはあらかじめはいっている値があることと、共有しているメンバーが数式を崩していつも修正をかけなければならないのです。更新が頻繁に入るために自分のPCほうで保管しておくことができません。
VBAをなんとかくみたいのですが、やり方がわからず悩んで今に至ります。