商品名の紐づけと数量および金額の転記

質問

マクロもしくは関数で下記処理を行いたいです。

添付画像の項目名は実際とは異なり例となりますが、
同一項目（例えば、シート１の「健康診断」とシート２の「一般検診」を同じものを指している）として扱います。

シート１の「健康診断」の項目に、シート２の「一般検診」の数量および金額を転記したいのですが、シート２の項目は時と場合に応じて項目数が変動します。
今月は３項目全てデータがあるが、次月は一般検診だけデータがなく、「おしぼり」と「プラスチック」だけデータがある、というような状態です。
シート１の項目においては据え置きで、シート２にて対応する項目のデータがなければ「０」と表記したいです。

このように転記元の項目数に変動（項目名は変わらない）があり、且つ転記先と項目名が異なる場合の、データ転記方法はどのようなものがあるでしょうか？

VLOOKUPでは希望する処理が出来ないと考えますので、マクロしかないのかな？と思っていますが…

回答No.9

HohoPapa

こんな感じでいかがでしょうか。

Function GetMyData(TName As String, YName As String) As Long

　Dim HitCol As Long
　Dim ColNum As Long
　Dim RowNum As Long
　Dim PairName As String
　Dim wsJisyo As Worksheet
　Dim wsMoto As Worksheet

　Const KeyCol = 2　'転記元、項目名の列番号
　Const KeyRow = 2　'転記元、列見出しの行番号

　Set wsJisyo = ThisWorkbook.Sheets("辞書")
　Set wsMoto = ThisWorkbook.Sheets("Sheet2")
　PairName = ""
　GetMyData = 0

　'辞書上で読み替え後の項目名を取得
　RowNum = 1
　Do
　　If wsJisyo.Cells(RowNum, 1).Value = "" Then Exit Do
　　If TName = wsJisyo.Cells(RowNum, 1).Value Then
　　　PairName = wsJisyo.Cells(RowNum, 2).Value
　　　Exit Do
　　End If
　　RowNum = RowNum + 1
　Loop

　'項目の転記元列番号を取得
　HitCol = 0
　ColNum = KeyCol + 1
　Do
　　If wsMoto.Cells(KeyRow, ColNum).Value = "" Then Exit Do
　　If wsMoto.Cells(KeyRow, ColNum).Value = YName Then
　　　HitCol = ColNum
　　　Exit Do
　　End If
　　ColNum = ColNum + 1
　Loop

　'戻り値取得／ヒットしなかったら抜ける
　If ((HitCol <> 0) And (PairName <> "")) Then
　　RowNum = KeyRow + 1
　　Do
　　　If wsMoto.Cells(RowNum, KeyCol).Value = "" Then Exit Do
　　　If wsMoto.Cells(RowNum, KeyCol).Value = PairName Then
　　　　GetMyData = wsMoto.Cells(RowNum, HitCol).Value
　　　End If
　　　RowNum = RowNum + 1
　　Loop
　End If

End Function

回答No.8

kkkkkm

対応商品が１対１でシート1にすべての項目が存在するならNo3のVlookup関数でいけるでしょう。
C列はあくまでも例でありC列でなく他の所で対応表を作ってもいいわけで
たとえばシート3のA列(シート2の商品)とB列(シート1の商品)とする対応表を作って
シート1のB列(項目)をシート3から(A1からデータがあればですが)
=VLOOKUP(Sheet3!A1,Sheet3!$A$1:$B$3,2,FALSE)
で持ってきて
No3のVLOOKUP($C3
の$C3をSheet3!$A1にしてデータを参照させたらできるでしょう。

回答No.7

imogasi

質問の状況の表現がよくわからない。
ーー
こういうことか。
＞シート１では「健康診断」」と言っているところへ算出する計数は、
シート２では、他の分類に表現されていることもあり、それらもまとめて集計したい、ということか？
・理由は、小生が想像するに、表現がバラバラとか、
健康診断と検診の両方あり、厳密には違っても今回は両者を含めたい、など
・一方は他方の一部（に含まれる）に相当するが、今回は両方をまとめて集計したい、など。衛生品とガーゼなど。
・当社での、業務上、費用（担当部署の）管理上、両者をまとめて係数を出したい。
カーゼ、マスク，検温計はまとめて、衛生消耗品とくくる、とか。
＝＝＝
もし上記のようなことなら、分類をまとめる、対応表、対応テーブルが必要で、これは（AIでも使わない限り、）人間が対応表を作らないとならないはず。語句の語尾が変化してるとか付加されている（サブコード的に）、程度で済まない限りは。
＝＝
この対応表があれば、シート２の新しい列にシート１の分類名を、上記対応表を使って振る。ACCESSのファイル結合などを使えばしまい。マッチングの処理や、
VLOOKUPでもエクセルのシートに対応表のセル範囲が作られれば使える。
ーー
そしてシート１の分類で、部分集計やカウントを出せば仕舞。
そこまでくれば、シート１の分類で、ソートをかけて、キーが変わるまで、集計や件数集計をして下記打でば良い。１読（ワンパス。全レコード１回読み）で処理できる。
＝＝＝
画像で質問する質問者が多いが、（上記が的外れかもしれないが）上記のように文章で相当説明しないとわかりにくい。

補足

健康診断と一般検診は同一項目（同じ商品）です。同様に、ウエットティッシュとおしぼり、ペットボトルとプラスチックはイコールです。ｒ
シート１にシート２の各同一項目のデータを転記したいです。
健康診断の項目には一般検診の数量と金額が転記される。同様に、ウエットティッシュの項目にはおしぼりの数量と金額が、ペットボトルの項目にはプラスチックの数量と金額を転記される処理を希望します。
また、健康診断と一般検診は同一項目（同じ商品）ですが、一般検診以外で健康診断と同じ項目（同じ商品）のものはありません。必ず１対１（健康診断には一般検診のみ、ペットボトルにはプラスチックのみ）の関係です。
最後に、シート１は売上表、シート２は売上表を作成するための元データとしています。
項目数（商品数）は11あります。売上表であるシート１には11項目全てを記載する必要があります。シート２の元データはシステムから抽出しているのですが、11項目（商品）全てに売上が無く、11項目（商品）のうち２項目（商品）は売上が無しとなれば、その項目はシステムから抽出したタイミングでその項目は表示されない（抽出されない）仕様となっています。
しかし、シート１の売上表には必ず１１項目のデータを記載する必要があるため、シート２の元データ内にて項目が無いもの（売上があがらなかったもの）については、シート１の該当項目にて「０」と記載しなければなりません。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
＜シート１＞（売上表）
健康診断
ウエットティッシュ
ペットボトル
電話
文房具
カレンダー
乗り物
扇風機
メディア
遊園地
東京タワー

＜シート２＞（元データ、システムから抽出）
一般検診
おしぼり
プラスチック
携帯電話
えんぴつ
日付
電車
サーキュレーター
テレビ
ディズニーランド
赤色

上記がそれぞれ対応しているとします。
しかし、売上が全ての項目にてない場合には、シート２のデータは以下のようになります。

＜シート２＞
一般検診
おしぼり
プラスチック
携帯電話
えんぴつ
電車
サーキュレーター
ディズニーランド
赤色

このように、シート２にて「日付」と「テレビ」はデータとして抽出されず、表示されないようになっています。
しかしシート１には対応する項目として「カレンダー」と「メディア」は必ず記載する必要がありますので、この場合は「カレンダー」と「メディア」には数量および金額を「０」と表示させたいです。

このような説明で伝わりましたでしょうか…？

回答No.6

HohoPapa

#4に補足です。

同義語（同意語）は２つで1組の場合、
かつ、単に一方通行で読み替えればいいのであれば、
つまり、
「健康診断」を「一般検診」と読み替えるだけなら
コードはよりシンプルにすることが可能です。

また、
扱う値が、整数だけという条件なら
私が提示したコードを直しますので指摘してください。

補足

#4の回答を確認させて頂きました、希望する処理がほぼ叶うコードだと思いました、ありがとうございます。

マッチングしたデータセルが無い場合は「０」としたいです。
また、扱う値は整数のみとなります。
項目名についてですが、HohoPapa様の仰る通り読み替えだけとなります。

回答No.5

kkkkkm

> 「今月は３項目全てデータがあるが、次月は一般検診だけデータがなく、「おしぼり」と「プラスチック」だけデータがある、というような状態です。
> シート１の項目においては据え置きで、シート２にて対応する項目のデータがなければ「０」と表記したいです。」

そんなことは分かってます。で、その「おしぼり」と「プラスチック」はシート１には無いけどどうするのかという話です。シート１が据え置き(そのままにしておくこと)なら転記しないという事になりますが、それでNo2の回答で、どうなんですか実行してみて思ったようになっていますかという事です。そもそも実行の仕方がわからないならマクロでなどと言わないようにしてください。

> シート１の「健康診断」の項目に、シート２の「一般検診」

こういうのが一対一での別名ならという話がNo3で、結局これの説明もなく、意味不明な事ばかり語られても、操作前、操作後がどうなっているのかが不明で、「と記載させて頂きました。」などと言われても結局全体としてどうしたいのかわかりません。

回答No.4

HohoPapa

>例えば、シート１の「健康診断」とシート２の「一般検診」を同じものを指している
ということから、同意辞書が必要と考えました。
また、同じ意味の単語が2つとは限らない条件で考えました。
マッチングしたデータセルが無い場合は0でいいんですね？
作り方次第では、"Not Found"と返すことも可能です。

添付画像のような配置を前提にしたコードが以下です。
c3=GetMyData($B3,C$2)　と埋め
必要数、下方向、横方向に複写します。

Function GetMyData(TName As String, YName As String)

　Dim MyCell As Range
　Dim HitRow As Long
　Dim HitCol As Long
　Dim ColNum As Long
　Dim RowNum As Long
　Dim HitFlg As Boolean
　Dim wsJisyo As Worksheet
　Dim wsMoto As Worksheet

　Const KeyCol = 2　'転記元、列見出しの行番号
　Const KeyRow = 2　'転記元、項目名の列番号
　Const StartRow = 3　'転記元、データ開始行
　Const Unmatch = 0

　HitFlg = False
　Set wsJisyo = ThisWorkbook.Sheets("辞書")
　Set wsMoto = ThisWorkbook.Sheets("Sheet2")

　'辞書上の行番号を取得
　HitRow = 0
　For Each MyCell In wsJisyo.UsedRange
　　If TName = MyCell.Value Then
　　　HitRow = MyCell.Row
　　　Exit For
　　End If
　Next

　'項目の転記元列番号を取得
　HitCol = 0
　ColNum = KeyCol + 1
　Do
　　If wsMoto.Cells(KeyRow, ColNum).Value = "" Then Exit Do
　　If wsMoto.Cells(KeyRow, ColNum).Value = YName Then
　　　HitCol = ColNum
　　　Exit Do
　　End If
　　ColNum = ColNum + 1
　Loop
　If ((HitCol = 0) Or (HitRow = 0)) Then
　　GetMyData = Unmatch
　　Exit Function
　End If

　'辞書にヒットした項目行、列名列のデータを取得
　ColNum = 1
　Do
　　If wsJisyo.Cells(HitRow, ColNum).Value = "" Then Exit Do
　　RowNum = KeyRow + 1
　　Do
　　　If wsMoto.Cells(RowNum, KeyCol).Value = "" Then Exit Do
　　　If wsJisyo.Cells(HitRow, ColNum).Value = _
　　　　　wsMoto.Cells(RowNum, KeyCol).Value Then
　　　　GetMyData = wsMoto.Cells(RowNum, HitCol).Value
　　　　HitFlg = True
　　　　Exit Do
　　　End If
　　　RowNum = RowNum + 1
　　Loop
　　If HitFlg = True Then Exit Do
　　ColNum = ColNum + 1
　Loop

　If HitFlg = False Then
　　GetMyData = Unmatch
　　Exit Function
　End If

End Function

回答No.3

kkkkkm

もし健康診断の別名が一般検診だけしかないというパターンならそれぞれ別名をC列に記載して( 添付画像は健康診断だけの別名を記載した状態です)
D3に
=IFERROR(VLOOKUP($C3,Sheet2!$B$3:$D$5,COLUMN(B:B),FALSE),0)
として右と下にコピーすればどうでしょう。
C列は非表示にしてもいけます。

補足

説明不足で申し訳ありません。
シート１は売上表、シート２は売上表を作成するための元データとして扱います。
シート２の元データはあるシステムから抽出します。
また、売上表ですので、毎月売上が上がる商品もあれば売上があがらない商品もあります。
売上があがらない商品についてはシート２の元データ内にて商品名（項目）が抽出されない仕様となっているため、先の質問で「今月は３項目全てデータがあるが、次月は一般検診だけデータがなく、「おしぼり」と「プラスチック」だけデータがある、というような状態です。
シート１の項目においては据え置きで、シート２にて対応する項目のデータがなければ「０」と表記したいです。」と記載させて頂きました。

回答No.2

kkkkkm

いまひとつ動作がわかりませんが、Sheet2にあってSheet1にないものは追加するのではなく無視ということでしょうか
以下を実行してみてください。

Sub Test()
Dim c As Range, FRange As Range
Dim SString As String

With Sheets("Sheet1")
For Each c In .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp))
With Sheets("Sheet2")
If c.Value = "健康診断" Then
SString = "一般検診"
Else
SString = c.Value
End If
Set FRange = .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp)).Find(What:=SString, LookIn:=xlValues)
If Not FRange Is Nothing Then
c.Offset(0, 1).Resize(1, 2).Value = FRange.Offset(0, 1).Resize(1, 2).Value
Else
c.Offset(0, 1).Resize(1, 2).Value = 0
End If
End With
Next
End With
End Sub

回答No.1

3620313

sheet1のC3セルに=IF(Sheet2!C3>0,Sheet2!C3,"0")
これをsheet1のC3:D5にコピーで良いのでは？