![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
No.6ベストアンサー
- 回答日時:
面白そうなので、作ってみました。
「データ番号 親品目 子品目」の構成で、試してみました。
対象部品表のブックにモジュールを追加して、以下のコードを追加してください。
部品表が選択された状態で「部品表作成()」を実行したら、一覧表が作成されます。
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.4
- 回答日時:
#1です。
>難しいのであれば、・・
いえいえ、私は非力ですから、そう早く思いこまないでください。
ただこの問題をエクセルでやろうと考えるレベルの人には、やさしくはないでしょうが。
それよりも、私が、他に聞いた事項(セル挿入などして・・以下)に答えていただいてません。
これらに答えてもらえば、後の回答者に参考になると思うのですが、残念です。
ーー
Vectorに
http://www.vector.co.jp/soft/win95/business/se26 …
のような、同じ目的らしいのがありました。
この回答への補足
>それとも後行にもしZ-Xが出たら、それまでのものが、全部1レベル下がるのですか。
この場合はエラー表示を出すので下げなくてもかまいません。
>セル挿入などして、見掛けだけの図を作れば(できれば)よいのか、構造を整理(反映・対応)したものを、何かで表現(記述)したもの(安直には多次元配列などのようなもの)、Tree構造などを作る必要がありますか。
挿入をおこなう見掛けだけの図でもいいです。
No.3
- 回答日時:
先の回答の結果ですが
========================================================
品目1品目2品目3
X A NULL
X B C
X B D
Y A NULL
Y C NULL
NULL NULL NULL
========================================================
となります。
なお、Excel VBA でも同じことができるとおもいます。
Vlookup および Hlookup を駆使すればできるとおもいます。
No.2
- 回答日時:
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 です。
詳細は 以下のURLを参照
http://www.atmarkit.co.jp/fdotnet/vs2005db/vs200 …
上記ツールで テーブルを新規作成し、データをインポートします。
以下のSQLを実行します。
===========================================================
テーブル作成のSQL
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.親品目
==========================================================
答えは以下のSQLコマンドを実行
EXEC 部品ストラクチャ
で答えが表示されます。
実際にコーディングしテストしました。
Access では Tree ビュークラスが使えないかもしれないので
できれば MS Visual Basic .NET 2005 express edition
もしくは MS Visual C# .NET 2005 express edition
どちらも無償でダウンロードできます。
などで Tree View で表現すればみやすいとおもいます。
データを読み込んで Tree View の ノードに追加するだけです。
VB.netなど実際にコーディングする場合は答えのストアドの最後の部分をデータセットデザイナに追加する際にはSELECT分のところバルクコピー「SELECT into 」などに訂正し、ファイル化することをお勧めします。
No.1
- 回答日時:
最近の経験者では無いですが、Windows以前に大型コンピュタかパソコンでこれと似たことをやろうとしたが、満足にはできなかったことを思い出しました。
相当しっかりした、アルゴリズムを見つけて、取り掛かる問題と思います。
世の中的には、諸所に出てくる良くあるパターンの問題なので、業務ソフト経験者が骨子を回答してくれると良いですが。
難しさは、部分的なB-Cの2者関係の集合から絶対的なX-B-Cを割り出す必要があることです。処理している行の前にXが出てくる保証は無いのでは無いですか。だから全行処理して、結果が固まる型の問題でしょうね。
ーー
絶対的に第何レベルかは親品目・子品目の中の文字列や範囲等で
割り出し可能ですか?これに頼るのは、入力ミスの影響などで、よくないですが。
ーー
それとも後行にもしZ-Xが出たら、それまでのものが、全部1レベル下がるのですか。
ーー
セル挿入などして、見掛けだけの図を作れば(できれば)よいのか、構造を整理(反映・対応)したものを、何かで表現(記述)したもの(安直には多次元配列などのようなもの)、Tree構造などを作る必要がありますか。
ーー
先ほど別の質問でTreeViewの質問があり、解説記事のご紹介
がありました。(思いつきですが、これを使えないか考えるのはどうでしょう。)表現・図示だけでも助かりそうですが。
ーー
最後に、コンピュターソフトは「作るより、使う」です。フリーソフトなどで無いかどうか、VECTORなどを手始めに調べて見てはどうでしょう。
この回答への補足
回答ありがとうございます。
難しいのであれば、下図のようにレベルを指定してからでもかまいません。
A列 B C D E
1行 レベル0 レベル1 親 レベル2 親
2 X A X C B
3 Y B X D B
4 A Y
5 C Y
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
MSFlexGrid 行選択状態
-
「Nullの使い方が不正です」の...
-
ListViewで表示されたデータの...
-
VBAでアクセスDBからデータの取...
-
COBOL数値転記の仕様
-
C# DataTableに最後に追加した...
-
VBAコンボボックスの内容が反映...
-
エクセルのセル最終行取得
-
アクセスでウェブ上のデータを...
-
エクセルVBA WEBからデータ取...
-
エクセルデータをVBで検索でき...
-
VBA 変数名に変数を使用したい。
-
2つ目のレコードの値を取得す...
-
ACCESS2010 実行時エラー 2766
-
Access 2010で実行時エラー3061
-
COBOLの基本的な事なので...
-
CString型 全角半角を意識せず...
-
VB6.0でSQLServerへ・・・Recor...
-
vba フィルター 複数条件 3つ以...
-
VB6.0の「vbFromUnicode」はVB....
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【C#】textBoxの指定行のデータ...
-
VBAでアクセスDBからデータの取...
-
「Nullの使い方が不正です」の...
-
C# DataTableに最後に追加した...
-
Excel VBAでフォルダ内の全テキ...
-
【VB.NET】Excelの最終行までの...
-
VBAコンボボックスの内容が反映...
-
XMLでデータとして画像を指定す...
-
エクセルのCSV読み込みについて
-
COBOL数値転記の仕様
-
Excel VBAで1週間毎にカテゴリ...
-
部品表
-
MSFlexGrid 行選択状態
-
クリスタルレポートでレコード...
-
ADODBでの行番号の取得、もしく...
-
エクセルのセル最終行取得
-
VB2005 で NetworkStream で取...
-
アクセスでウェブ上のデータを...
-
VB2010で、選択した系列を最前...
-
java / jsp selectedについて
おすすめ情報