![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?a65a0e2)
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で質問しましょう!
似たような質問が見つかりました
- その他(データベース) c言語の問題です。これを踏まえてコーディングしたいのでおしえていただきたいです。 3 2023/08/03 09:27
- Excel(エクセル) エクセルでのVBA 2 2022/08/03 06:48
- その他(データベース) pythonでsqlight勉強中、クエリー結果の利用法教えて下さい 1 2022/04/28 20:38
- Visual Basic(VBA) 【VBA】データを入力後に,同一シート内に履歴として転記するVBAコードを教えていただきたいです。 3 2022/11/16 01:37
- Excel(エクセル) 【条件付き書式】countifsで複数条件を満たしたセルを赤くする方法 2 2023/02/09 23:53
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Visual Basic(VBA) 【VBA】複数行あるカンマ区切りのデータを全て縦に一列に並べたい 5 2022/04/13 17:03
- Excel(エクセル) Excel 表の作成について 3 2022/06/16 12:15
- その他(Microsoft Office) Excelで総数量を変動させたい 2 2022/11/04 23:49
このQ&Aを見た人はこんなQ&Aも見ています
-
今年はじめたいことは?
今年はこれをはじめたい!ということを教えてください!
-
スマホに会話を聞かれているな!?と思ったことありますか?
スマートフォンで検索はしてないのに、友達と話していた製品の広告が直後に出てきたりすることってありませんか? こんな感じでスマホに会話を聞かれているかも!?と思ったエピソードってありますか?
-
もし10億円当たったら何に使いますか?
みなさんの10億円プランが知りたいです!
-
コーピングについて教えてください
皆さんはストレスを感じたとき、どのような方法や手段、テクニックで対処していますか?
-
「これいらなくない?」という慣習、教えてください
現代になって省略されてきたとはいえ、必要性のない慣習や風習、ありませんか?
-
ツリー構造をRDBで表現するには?
その他(データベース)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
XMLでデータとして画像を指定す...
-
C# DataTableに最後に追加した...
-
VBAでアクセスDBからデータの取...
-
ADODBでの行番号の取得、もしく...
-
【VB.NET】Excelの最終行までの...
-
ListViewで表示されたデータの...
-
【C#】textBoxの指定行のデータ...
-
「Nullの使い方が不正です」の...
-
アクセスでウェブ上のデータを...
-
Smartyのプラグインについて
-
Excel VBA で日付を4ケタの数値...
-
【エクセルVBA】DBのデータをCSVに
-
クリスタルレポートでレコード...
-
COBOL数値転記の仕様
-
矩形グラフ(オシロやロジアナ...
-
【ExcelVBA】値を変更しながら...
-
Excel VBAでグラフの可変データ...
-
VB2010で、選択した系列を最前...
-
Excel VBAで1週間毎にカテゴリ...
-
MSFlexGrid 行選択状態
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
C# DataTableに最後に追加した...
-
VBAでアクセスDBからデータの取...
-
VBAコンボボックスの内容が反映...
-
【C#】textBoxの指定行のデータ...
-
【VB.NET】Excelの最終行までの...
-
XMLでデータとして画像を指定す...
-
「Nullの使い方が不正です」の...
-
COBOL数値転記の仕様
-
【ExcelVBA】値を変更しながら...
-
ListViewで表示されたデータの...
-
非同期のプロセス間通信(パイプ...
-
Excel VBAでフォルダ内の全テキ...
-
クリスタルレポートでレコード...
-
エクセルのCSV読み込みについて
-
アクセスでウェブ上のデータを...
-
エクセルのセル最終行取得
-
部品表
-
VB2010で、選択した系列を最前...
-
矩形グラフ(オシロやロジアナ...
-
エクセルデータをVBで検索でき...
おすすめ情報