部品表

質問

下のようなデータからストラクチャー部品表をつくるVBAプログラムを教えてもらいたいのですが。

　　　A列　　　　　　Ｂ　　　Ｃ
1行　データ番号　親品目　子品目
２　　１　　　　　　　Ｘ　　　　Ａ　
３　　２　　　　　　　Ｘ　　　　Ｂ　
４　　３　　　　　　　Ｙ　　　　Ａ
５　　４　　　　　　　Ｙ　　　　Ｃ　
６　　５　　　　　　　Ｂ　　　　Ｃ　
７　　６　　　　　　　Ｂ　　　　Ｄ　

このデータ（実際は任意に入力）から下のような表を作成

Ｘ――Ａ
　　|
　　―Ｂ――Ｃ
　　　　　　|
　　　　　　―Ｄ
Ｙ――Ａ
　　|
　　―Ｃ

回答No.6

1050 円（@1050YEN） · ベストアンサー

面白そうなので、作ってみました。
「データ番号　親品目　子品目」の構成で、試してみました。
対象部品表のブックにモジュールを追加して、以下のコードを追加してください。

部品表が選択された状態で「部品表作成()」を実行したら、一覧表が作成されます。

Excelをデータベースとして利用したサンプルです。
対象のブックは、保存されている必要があります。「部品表作成()」の中にThisWorkbook.Saveというのが存在するのは、その対応のためです。

もし保存するのがいやであれば、エクセルのRange.Findを駆使し、同様な考え方でできる(?)と思いますよー

Option Explicit

Sub 部品表作成()
　　Dim l_xlsBook　 As Excel.Workbook
　　Dim l_xlsSheet　As Excel.Worksheet
　　Dim l_strPath　 As String
　　Dim l_strSheet　As String

　　'まず保存
　　ThisWorkbook.Save

　　'ブックのパス
　　l_strPath = ThisWorkbook.FullName
　　'対象のシート名
　　l_strSheet = ThisWorkbook.ActiveSheet.Name

　　'出力先のブック
　　Set l_xlsBook = Workbooks.Add
　　'出力先のブックのシート1に出力
　　Set l_xlsSheet = l_xlsBook.Worksheets(1)

　　'接続
　　Call 一覧作成(l_xlsSheet, l_strPath, l_strSheet)
End Sub

Sub 一覧作成( _
　　　　ByRef p_xlsSheet As Excel.Worksheet, _
　　　　ByVal p_strXlsPath As String, _
　　　　ByVal p_strSheetName As String _
)
　　Dim l_strTbl　　As String
　　Dim l_strSQL　　As String
　　Dim l_adoCnn　　As Object
　　Dim l_adoRec　　As Object
　　Dim l_lng基点行 As Long
　　Dim l_str品目　 As String

　　'接続を行う
　　Set l_adoCnn = 取得_ExcelCnn(p_strXlsPath)

　　'SQL文用にシート名をテーブルとして認識を行うための変換
　　l_strTbl = "[" & p_strSheetName & "$]"

　　'親品目だけに存在するレコードを取得する
　　l_strSQL = ""
　　l_strSQL = l_strSQL & "SELECT DISTINCT 親品目 FROM " & l_strTbl & vbCrLf
　　l_strSQL = l_strSQL & "WHERE　親品目 NOT IN (" & vbCrLf
　　l_strSQL = l_strSQL & "　　　　 SELECT 子品目 FROM " & l_strTbl & vbCrLf
　　l_strSQL = l_strSQL & ")" & vbCrLf
　　Set l_adoRec = l_adoCnn.Execute(l_strSQL)

　　'基点を先頭にする
　　l_lng基点行 = 1
　　Do Until l_adoRec.EOF
　　　　'品目を取得する
　　　　l_str品目 = CStr(l_adoRec(0))

　　　　'指定の品目にぶら下がる品目を部品表化する
　　　　Call 一覧作成実行部(p_xlsSheet, l_adoCnn, l_strTbl, l_str品目, l_lng基点行)

　　　　'編集が行われた最終行+1を、新たな基点とする
　　　　l_lng基点行 = p_xlsSheet.Cells.SpecialCells(xlLastCell).Row + 1

　　　　'レコード移動
　　　　l_adoRec.MoveNext
　　Loop

　　'セルの自動幅調整
　　p_xlsSheet.Cells.Columns.AutoFit
End Sub

Private Sub 一覧作成実行部( _
　　　　ByRef p_xlsSheet As Excel.Worksheet, _
　　　　ByRef p_adoCnn As Object, _
　　　　ByVal p_strTbl As String, _
　　　　ByVal p_str品目 As String, _
　　　　ByVal p_lng基点行 As Long, _
　　　　Optional ByVal p_lng行level As Long = 0, _
　　　　Optional ByVal p_lng列level As Long = 0 _
)
　　Dim l_strSQL　　As String
　　Dim l_adoRec　　As Object
　　Dim l_xlsRng　　As Excel.Range
　　Dim l_str品目　 As String

　　'位置(V方向:「基点」+「行レベル」/H方向:「列レベル」+1)取得
　　Set l_xlsRng = p_xlsSheet.Cells((p_lng行level + p_lng基点行), p_lng列level + 1)
　　'パラメータの品目を書き込む
　　l_xlsRng.Value = p_str品目

　　'列レベルがトップでなければ、横罫線を書き込む
　　If (p_lng列level <> 0) Then
　　　　l_xlsRng.Offset(, -1).Value = "─"
　　End If
　　'行レベルがトップでなければ、縦罫線を書き込む
　　If (p_lng行level <> 0) Then
　　　　l_xlsRng.Offset(-1, -1).Value = "│"
　　End If

　　'パラメータの品目以下にぶら下がる子品目を取得する
　　l_strSQL = ""
　　l_strSQL = l_strSQL & "SELECT 子品目 FROM " & p_strTbl & vbCrLf
　　l_strSQL = l_strSQL & "WHERE　親品目 = '" & p_str品目 & "'" & vbCrLf
　　l_strSQL = l_strSQL & "ORDER BY データ番号" & vbCrLf
　　Set l_adoRec = p_adoCnn.Execute(l_strSQL)

　　'新たな基点行を設定
　　p_lng基点行 = p_lng基点行 + p_lng行level

　　'行レベルの初期化
　　p_lng行level = 0
　　Do Until l_adoRec.EOF
　　　　'品目を取得する
　　　　l_str品目 = CStr(l_adoRec(0))

　　　　'指定の品目にぶら下がる品目を部品表化する
　　　　Call 一覧作成実行部(p_xlsSheet, p_adoCnn, p_strTbl, l_str品目, p_lng基点行, p_lng行level, p_lng列level + 2)

　　　　'行レベルを変更する
　　　　p_lng行level = p_lng行level + 2

　　　　'レコード移動
　　　　l_adoRec.MoveNext
　　Loop
End Sub

'OLEDBによる、エクセルコネクション
Function 取得_ExcelCnn( _
　　　　ByVal p_Path As String _
) As Object
　　Dim l_strCnn　　As String
　　Dim l_adoCnn　　As Object
　　l_strCnn = Join(Array( _
　　　　　　"Provider=Microsoft.Jet.OLEDB.4.0", _
　　　　　　"Data Source=" & p_Path, _
　　　　　　"Extended Properties=""Excel 5.0;HDR=YES""" _
　　　　　　), ";")
　　Set l_adoCnn = CreateObject("ADODB.Connection")
　　l_adoCnn.CursorLocation = 3 ' ADODB.CursorLocationEnum.adUseClient
　　l_adoCnn.Open l_strCnn

　　Set 取得_ExcelCnn = l_adoCnn
End Function

お礼

ありがとうございます。

回答No.5

NOBNNN

#2です。
回答を書いたつもりですが返事はいただけないようなので
がっかりしています。
何かしらコメントをするべきだと思いますが・・・

回答No.4

imogasi

＃１です。
＞難しいのであれば、・・
いえいえ、私は非力ですから、そう早く思いこまないでください。
ただこの問題をエクセルでやろうと考えるレベルの人には、やさしくはないでしょうが。
それよりも、私が、他に聞いた事項（セル挿入などして・・以下）に答えていただいてません。
これらに答えてもらえば、後の回答者に参考になると思うのですが、残念です。
ーー
Ｖｅｃｔｏｒに
http://www.vector.co.jp/soft/win95/business/se266918.html
のような、同じ目的らしいのがありました。

補足

＞それとも後行にもしＺ－Ｘが出たら、それまでのものが、全部１レベル下がるのですか。
この場合はエラー表示を出すので下げなくてもかまいません。

＞セル挿入などして、見掛けだけの図を作れば（できれば）よいのか、構造を整理（反映・対応）したものを、何かで表現（記述）したもの（安直には多次元配列などのようなもの）、Ｔｒｅｅ構造などを作る必要がありますか。
挿入をおこなう見掛けだけの図でもいいです。

回答No.3

NOBNNN

先の回答の結果ですが
========================================================
品目1 品目２ 品目３
　X　　　　A　　　NULL
　X　　　　B　　　　C
　X　　　　B　　　　D
　Y　　　　A　　　NULL
　Y　　　　C　　　NULL
　NULL　　NULL　　NULL
========================================================
となります。
なお、Excel　VBA でも同じことができるとおもいます。
Vlookup および　Hlookup を駆使すればできるとおもいます。

回答No.2

NOBNNN

SQL の命令で処理ができると思いますが・・・
SQL SERVER もしくはAccess 2000以降のバージョンが
あればできます。
excel などに例文のデータを作成します。
MS ACSESS 2003もしくは SQL SERVER 2005
SQL SERVER 2000なら SQL Server Enterprise Manager
SQL SERVER 2005なら SQL Server Management Studio
なお、 SQL Server 2005 については
無償で提供されています。
無償データベース SQL Server 2005 Express Edition　です。
　詳細は　以下のＵＲＬを参照
http://www.atmarkit.co.jp/fdotnet/vs2005db/vs2005db_02/vs2005db_02_01.html

上記ツールで　テーブルを新規作成し、データをインポートします。
以下のＳＱＬを実行します。
===========================================================
テーブル作成のＳＱＬ

USE [部品SQL]
GO
/****** オブジェクト: Table [dbo].[部品TBL] スクリプト日付: 06/03/2006 20:39:13 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[部品TBL](
[データ番号] [float] NULL,
[親品目] [nvarchar](255) COLLATE Japanese_CI_AS NULL,
[子品目] [nvarchar](255) COLLATE Japanese_CI_AS NULL
) ON [PRIMARY]
==========================================================
==========================================================
答え
create PROCEDURE 部品ストラクチャ
AS
SELECT A.親品目 AS 品目1,A.子品目 AS 品目2
into #品目TBL1
FROM 部品TBL As A
left outer join
( selecT * FROM 部品TBL ) AS B
on A.親品目 = B.子品目
WHERE B.親品目 is null

selecT A.*,B.子品目 AS 品目3 FROM #品目TBL1 AS A
left OUTER JOIN 部品TBL AS B
ON A.品目2 = B.親品目
==========================================================
答えは以下のＳＱＬコマンドを実行
EXEC 部品ストラクチャ
で答えが表示されます。
実際にコーディングしテストしました。

Access では　Tree ビュークラスが使えないかもしれないので
できれば　MS Visual Basic .NET 2005 express edition
もしくは MS Visual C# .NET 2005 express edition
どちらも無償でダウンロードできます。
などで　Tree View で表現すればみやすいとおもいます。
データを読み込んで　Tree View　の　ノードに追加するだけです。
VB.netなど実際にコーディングする場合は答えのストアドの最後の部分をデータセットデザイナに追加する際にはＳＥＬＥＣＴ分のところバルクコピー「SELECT into 」などに訂正し、ファイル化することをお勧めします。

回答No.1

imogasi

最近の経験者では無いですが、Ｗｉｎｄｏｗｓ以前に大型コンピュタかパソコンでこれと似たことをやろうとしたが、満足にはできなかったことを思い出しました。
相当しっかりした、アルゴリズムを見つけて、取り掛かる問題と思います。
世の中的には、諸所に出てくる良くあるパターンの問題なので、業務ソフト経験者が骨子を回答してくれると良いですが。
難しさは、部分的なＢ－Ｃの２者関係の集合から絶対的なＸ－Ｂ－Ｃを割り出す必要があることです。処理している行の前にＸが出てくる保証は無いのでは無いですか。だから全行処理して、結果が固まる型の問題でしょうね。
ーー
絶対的に第何レベルかは親品目・子品目の中の文字列や範囲等で
割り出し可能ですか？これに頼るのは、入力ミスの影響などで、よくないですが。
ーー
それとも後行にもしＺ－Ｘが出たら、それまでのものが、全部１レベル下がるのですか。
ーー
セル挿入などして、見掛けだけの図を作れば（できれば）よいのか、構造を整理（反映・対応）したものを、何かで表現（記述）したもの（安直には多次元配列などのようなもの）、Ｔｒｅｅ構造などを作る必要がありますか。
ーー
先ほど別の質問でＴｒｅｅＶｉｅｗの質問があり、解説記事のご紹介
がありました。（思いつきですが、これを使えないか考えるのはどうでしょう。）表現・図示だけでも助かりそうですが。
ーー
最後に、コンピュターソフトは「作るより、使う」です。フリーソフトなどで無いかどうか、ＶＥＣＴＯＲなどを手始めに調べて見てはどうでしょう。

補足

回答ありがとうございます。
難しいのであれば、下図のようにレベルを指定してからでもかまいません。

　　　　Ａ列　　　Ｂ　 　　　Ｃ　　　　　Ｄ　　　Ｅ
1行　レベル0　レベル1　親　　レベル2　 親
２　　Ｘ　　　　　Ａ　 　　　Ｘ　　　　　Ｃ　　　Ｂ
３　　Ｙ　　　　　Ｂ　　 　　Ｘ　　　　　Ｄ　　　Ｂ
４　　　　　　　　Ａ　　 　　Ｙ　　　
５　　　　　　　　Ｃ　　 　　Ｙ