商品と部品の紐付けエクセルファイルの作成

質問

下記画像の様に、商品の仕様にチェックして別のExcelファイルにこのパーツを使用している商品を一覧として出力させるようなものを作りたいのですが、方法はないでしょうか？
特に商品やパーツが増えたら、Excelの行や列を増やして対応できるようにしたいのです。

ご教授をお願い致します。

回答No.8

masnoske

Accessを勉強できるように、テーブルを作ってから希望されるワークシート（パーツ逆転回）を作成するマクロを組んでみました。

画像のワークシート名が不明なので Sheet1 としました。
マクロを実行する前に４つのワークシートを追加し、それぞれの名前を
商品、仕様、パーツ展開、パーツ逆展開
として下さい。

Sub main()
Dim tbl1 As Range
Dim tbl2 As Range
Dim tShouhin As Range
Dim tSiyou As Range
Dim tList As Range
Dim i As Long, j As Long, k As Long
Dim cnt As Long
Dim shouhin As String
Dim siyou As String
Dim parts As String
Dim str As String

' 商品テーブル作成
Set tbl1 = Worksheets("Sheet1").Range("A1").CurrentRegion
Worksheets("商品").Cells.ClearContents
cnt = 0
For i = 2 To tbl1.Rows.Count
For j = 2 To tbl1.Columns.Count
If tbl1(i, j).Value = "○" Then
cnt = cnt + 1
Worksheets("商品").Cells(cnt, 1).Value = tbl1(i, 1).Value
Worksheets("商品").Cells(cnt, 2).Value = tbl1(1, j).Value
End If
Next
Next

' 仕様テーブル作成
Set tbl2 = Worksheets("Sheet1").Range("H2").CurrentRegion
Worksheets("仕様").Cells.ClearContents
cnt = 0
For i = 2 To tbl2.Columns.Count
For j = 2 To tbl2.Rows.Count
If tbl2(j, i).Value = "○" Then
cnt = cnt + 1
Sheets("仕様").Cells(cnt, 1).Value = tbl2(1, i).Value
Sheets("仕様").Cells(cnt, 2).Value = tbl2(j, 1).Value
End If
Next
Next

' パーツ展開作成
Set tShouhin = Worksheets("商品").Range("A1").CurrentRegion
Set tSiyou = Worksheets("仕様").Range("A1").CurrentRegion
Worksheets("パーツ展開").Cells.ClearContents
cnt = 0
For i = 2 To tbl1.Rows.Count
shouhin = tbl1(i, 1).Value
For j = 1 To tShouhin.Rows.Count
If tShouhin(j, 1).Value = shouhin Then
siyou = tShouhin(j, 2).Value
For k = 1 To tSiyou.Rows.Count
If tSiyou(k, 1).Value = siyou Then
cnt = cnt + 1
Worksheets("パーツ展開").Cells(cnt, 1) = shouhin
Worksheets("パーツ展開").Cells(cnt, 2) = tSiyou(k, 2).Value
End If
Next
End If
Next
Next

' パーツ逆展開作成
Set tList = Worksheets("パーツ展開").Range("A1").CurrentRegion
Worksheets("パーツ逆展開").Cells.ClearContents
For i = 2 To tbl2.Rows.Count
parts = tbl2(i, 1).Value
str = ""
For j = 1 To tList.Rows.Count
If tList(j, 2).Value = parts Then
If InStr(str, tList(j, 1).Value) = 0 Then
str = str & tList(j, 1).Value & ","
End If
End If
Next
str = Left(str, Len(str) - 1)
Worksheets("パーツ逆展開").Cells(i, 1) = parts
Worksheets("パーツ逆展開").Cells(i, 2) = str
Next
End Sub

Accessで処理する場合は、商品ワークシートと仕様ワークシートをテーブルにすればOKです。パーツ展開とパーツ逆展開は、クエリとVBAで作成できます。

気になったのは、パーツ1 で 商品4 が２回出てきます。
出力の結果は、ダブリがないように処理していますが、もしも 商品4 では パーツ1 を 2個使うという意味なら、パーツ展開表に個数の列を追加してマクロも変更する必要があります。

回答No.7

imogasi

#5です。＃５のコードの１例です。
Ｓｈｅｅｔ２のＡ１：Ｅ７にデータ（とりあえず質問に添付された画像の通りです）
商品名 仕様１ 仕様２ 仕様３ 仕様４
商品１ 　 〇
商品２ 　〇
商品３ 　〇
商品４ 　 〇　 〇
商品５
商品６ 　〇
Ｓｈｅｅｔ２のＨ１：Ｌ５　に
◯の位置は崩れますが、ご容赦を。実際にやったシートを見てください。
パーツ名 仕様１ 仕様２ 仕様３ 仕様４
パーツ１ 〇 〇 〇
パーツ２ 〇
パーツ３ 〇
パーツ４ 〇
と質問画像の通りあるとします。
これらは別シートにすべきと思いますが、そのままで。
ーーー
Ｓｈｅｅｔ３に結果を出します。
＝＝＝
標準モジュールに
下記コードで、データ例が多い場合は、ＭｓｇＢｏｘの行を削除するかコメント化してください。
Sub test03()
Dim temp
Set sh1 = Worksheets("Sheet2")
Set sh2 = Worksheets("Sheet3")
'---
lr = sh1.Cells(1000, "H").End(xlUp).Row
MsgBox "Sheet2 H列　最終行＝" & lr
ii = 3
jj = 2 'Sheet3の列はＢ列から書き出し用意
'----
For i = 2 To lr
lc = sh1.Cells(i, 1000).End(xlToLeft).Column
MsgBox "最右列の〇の列= " & lc

For Each cl In Range(sh1.Cells(i, 9), sh1.Cells(i, lc)) 'Ｉ列より右で〇のセルを探す

If cl = "〇" Then
temp = sh1.Cells(1, cl.Column)
'MsgBox temp(j)
c = sh1.Range("A1:F1").Find(temp).Column
MsgBox "〇のＡ-Ｆ列の位置= " & c
Set sho = sh1.Range(sh1.Cells(2, c), sh1.Cells(1000, c)).Find("〇")
MsgBox sh1.Cells(sho.Row, 1)
Shonm = sh1.Cells(sho.Row, 1)
'jj = 2
sh2.Cells(ii, jj) = Shonm 'Sheet3に書き出し
jj = jj + 1
strAdr = sho.Address
'--
Do
Set sho = sh1.Range(sh1.Cells(2, c), sh1.Cells(1000, c)).FindNext(sho)
If sho Is Nothing Then
Exit Do
Else
If strAdr <> sho.Address Then
MsgBox sh1.Cells(sho.Row, 1)
Shonm = sh1.Cells(sho.Row, 1)
sh2.Cells(ii, jj) = Shonm 'Sheet3に書き出し
jj = jj + 1
End If
End If

Loop While sho.Address <> strAdr

End If
'以上で「仕様ｎ」分処理終り
Next
'--以上で「パーツｎ」分処理終り
ii = ii + 1 'Sheet3の次の行に書き出し用意
jj = 2 'Sheet3の列はＢ列から書き出し用意
Next i '次のパーツ行の処理

End Sub
結果
Ｓｈｅｅｔ３のＡ３：Ｇ６に
パーツ１ 商品２ 商品６ 商品３ 商品４ 商品４ 商品１
パーツ２ 商品３ 商品４
パーツ３ 商品２ 商品６
パーツ４ 商品４ 商品１
となる。Ａ列の「パーツｎ」は、実行前に、手入力したもの。
＝＝＝
標準モジュールに
'列で並べ替え
'https://jun1ch.com/excel-across-sort
Sub test05()
Dim r As Range
Dim srng As Range
Set srng = Range("B3:G6")
For Each r In srng
'列単位昇順並べ替え
r.Resize(, 6).Sort Key1:=r, _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlLeftToRight, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Next
End Sub
実行結果
パーツ１ 商品１ 商品２ 商品３ 商品４ 商品４ 商品６
パーツ２ 商品３ 商品４
パーツ３ 商品２ 商品６
パーツ４ 商品１ 商品４
商品のダブり（例　商品４）は消せてないが、とりあえず、そのままにしておく。
なお商品名は、文字列的には、具体的には、バラバラで、社内ルールで人気のある並べ順や構造化されたネーミング順にする（ＶＢＡでする）のは、また一苦労でしょうね。
テスト例のデータ行数や多様性が少ないので、他でうまく行くか心配だが、
折角作ったので挙げておく。
こういうロジックやＶＢＡでの方法では、コードの可動性も悪く、良くない。
他の隔絶してよい方法もないのではないかと思う。
どちらかというテーブル方式（リレーショナルデータベース式）で、製品と部品の構造を定義するのでなく、網目状の（質問者の言う、紐づけ？）の関係を定義する考え方が必要な気がする。そしてそれを処理するソフトが必要かと。

回答No.6

imogasi

#5です。
質問者の後学のために
http://parts.free-webservice.com/
のようなフリーソフトの案内でも見ておいてはどうですか？
Ｇｏｏｇｌｅで「部品管理表　フリーソフト」か「部品管理　フリーソフト」で照会して出てくるものの機能の紹介文などを読む。

回答No.5

imogasi

処理ロジックは、人間が頭と目と紙の表を使って処理する場合の手順に沿って考えてみました。
ーー
（１）「パーツ表（第２表）」で、上から下へ見て、最初に出る「パーツ１」の行を、左より右へ目で見て探して行き、〇のある最初の列「仕様１」を知り、
（２）「商品表」（第１表）の第１行の、「仕様１」の列を見て、上から下に〇を探し、「商品名２」に至る
（３）第3表に「パート１」の行を見て、（２）で判った「商品名２」を、そして次に「商品名６」を、「第３表」のパート１」の行に列的に追加して行く。
（４）（１）に次に「仕様２」がの列が〇なので、「商品名表」の「仕様２」の列を見て、「商品名３」や「商品名４」が〇なので、それらの商品名を、「表３」の「パーツ１の列に加える。
こういった作業を、ＶＢＡで記述するわけです。
上記説明文を作るだけでも大変時間がかかる。
ＶＢＡコード作成も目安はついたが、すでにＶＢＡコードの回答も出ているので、回答を締め切られる恐れが多いので、時間があれば載せますが、今回は略。
上記のロジックで、ＶＢＡコードを作っても、泥臭い繰り返しで、すっきりしたものにならない。エクセルＶＢＡでやるとそれ以上すっきりしたやり方はないのではないかな。
　すでに指摘が出いているＡｃｃｅｓｓを使う方法も、エクセルＶＢＡより良いが（条件でＳＥＬＥＣＴやテーブルの結合機能が使えるので）、やはり、VBAコードの複雑さを免れ得ないのでは。
＝＝＝＝＝
言いたいことは、こういう課題は、メーカー的な仕事の場では、必須のニーズだと思う。そして質問のようなこと以外も様々な盛り込むべきニーズがあると思う。
だから世間には本格的な、部品管理表処理的なソフトが作られ、使われていると思う。
勿論素人が作ったものでなく、専門家が作ってシステムとして売り出されていて、利用とメンテナンス料は高額なものだろう。それだけ素人がやるべき分野じゃないということだと思う。
最低でも、できることを限定したフリーソフトを探すか、社内の仕事の担当者や、システムの専門家が加わって、どうするか検討すべき事項と思う。
　質問者は質問の添付図の様子から、全くの素人と思えないが、VBAやこういった仕事のスキルがわからず、回答しにくい。

お礼

ご解答ありがとうございます。
おっしゃられている通り、Excelは多少使えるけど、VBAのような本格的なプログラムを組めるほどではない。Accessは触ったことはあるけど・・・程度のレベルです。

確かにお金を出してソフトウエア開発を依頼した方が良いのですが、弊社上層部は費用対効果が悪いという良くある理由で承諾を得られません。なので現状ある、Excelで何かやりようがないかと考えている最中です。
合わせて言うなら、セキュリティに関して問題があるとし、フリーソフトの使用も禁じられています。（その割には「安いから」という理由でパチモンソフトを使わせますが。）

ご教授いただいたコードの半分ぐらいしか意味が理解できていませんがとりあえず試してみたいと思います。

回答No.4

masnoske

自分でマクロの保守ができないなら、Accessでやるのが正解だと思います。

回答No.3

kkkkkm

Sheets("Sheet1") '商品名のシート
Sheets("Sheet2") 'パーツのシート
Sheets("Sheet3") '出力用シート

を作成して下さい。
仕様1などは商品名のシートとパーツのシートで完全に一致させておいてください。

出力用シート以外はA1から項目名を含めてデータを入れてください。
質問の添付画像に左の表のように
出力用のシートは何も記載しなくていいです。

出力用シートのコピーが新規ブックとして開きます。

Sub Test()
Dim i As Long, J As Long
Dim LastRow1 As Long, LastRow2 As Long
Dim LastColumn1 As Long, LastColumn2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim FRange1 As Range, FRange2 As Range
Dim siyoX As String

Set Sh1 = Sheets("Sheet1") '商品名のシート
Set Sh2 = Sheets("Sheet2") 'パーツのシート
Set Sh3 = Sheets("Sheet3") '出力用シート

LastColumn1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LastColumn2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow1 = Sh1.Cells(Rows.Count, "A").End(xlUp).Row
LastRow2 = Sh2.Cells(Rows.Count, "A").End(xlUp).Row

'出力シートパーツ名をパーツシートからA3以降にコピーしてのB列のデータを削除する。
With Sh3
.Range("A1").Value = "パーツが使用されている商品の一覧"
.Range("A2").Value = "パーツ名"
.Range("B2").Value = "商品名"
.Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)).ClearContents
.Range(.Cells(3, "A"), .Cells(LastRow2 + 1, "A")).Value = _
Sh2.Range(Sh2.Cells(2, "A"), Sh2.Cells(LastRow2, "A")).Value

End With

For i = 2 To LastRow1
Set FRange1 = Sh1.Range(Sh1.Cells(i, "B"), Sh1.Cells(i, LastColumn1)).Find("◯", LookAt:=xlWhole)
If Not FRange1 Is Nothing Then
siyoX = Sh1.Cells(1, FRange1.Column).Value
Set FRange2 = Sh2.Range(Sh2.Cells(1, "B"), Sh2.Cells(i, LastColumn2)).Find(siyoX, LookAt:=xlWhole)
If Not FRange2 Is Nothing Then
For J = 2 To LastRow2
If Sh2.Cells(J, FRange2.Column).Value = "◯" Then
Sh3.Cells(J + 1, "B").Value = Sh3.Cells(J + 1, "B").Value & Sh1.Cells(i, "A").Value & "、"
End If
Next
End If
Else
MsgBox "'" & "◯" & "'はありませんでした"
End If
Next i
Sh3.Copy
End Sub

回答No.2

f272

VBAを使ってやれば可能です。
エクセルの関数を使うことでも可能でしょうが，作業列を作成するとか，複雑な関数を使うとかになるでしょうから，実際には運用できなくなるでしょう。

回答No.1

k-josui

これはデーターベースですから、Accessで作った方がよい。
取り付きは少し厄介ですが、後々扱いが楽になります。