エクセルで階層リストを作成

質問

エクセルで以下の様な勘定科目のリストがあります。
これをエクセルの別シートに階層表示のリストにしたいのですが、知恵をお貸し下さい。
≪勘定科目リスト≫
【勘定科目名】 【属性名】 【階層】 【集計先名1】 【集計先名2】
売上高　　　　　　 集計 　　　1 　　　売上総利益　　
電気部門売上　　集計　 　　2 　　　売上高 　　　 電気部門粗利　　
カメラ売上　　　　 原始 　　　3 　　　電気部門売上 　　
食品部門売上　　 集計 　　2　　 　売上高　　　 　食品部門粗利　　
惣菜売上　　　　　 原始　 　　3 　　食品部門売上　　
粗利　　 　 　　　　集計　 　　　1
電気部門粗利 　　集計 　　2 　　 粗利　　
食品部門粗利　　 集計 　　2　　 粗利　　

≪作成したい階層リストイメージ≫※レイアウトが見づらくてすみません。罫線は実際のシートには必要ありません。セルの階層表示されるのが目的です。
【勘定科目名】 【属性名】 【勘定科目名】 【属性名】 【勘定科目名】【属性名】
売上高　　　　　　　集計　　電気部門売上　　　集計　　カメラ売上　　 原始
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　|-----PC売上　　 原始　　
　　　　 　　　　　　　 | ------食品部門売上　　　集計　　 　惣菜売上　　 原始　　 　
粗利　　 集計　　 　電気部門粗利　　 集計　　
　　　　　 　　 |-----食品部門粗利　　 集計

回答No.4

myRange · ベストアンサー

再度結果を眺めてみて気づきました。
間違いあり。

階層一覧シートの見出し作成の部分

＞Range("A1,D1,G1").Value = Array("属性１", "属性２", "属性３")

これを

Range("A1:I1").Value = Array("属性１", "", "", "属性２", "", "", "属性３", "", "")

と入れ替えてください。
これで大丈夫。。(^^;;;

お礼

myRange様
ありがとう御座います！
試してみます。m(__)m

回答No.6

tom04

No.5です！
たびたびごめんなさい。

投稿した後で、Sheet1のA列が抜けているのに気づきました。

今一度、Sheet1のみの画像をアップさせていただきます。

どうも何度も失礼しました。m(__)m

お礼

tom04様
関数でもここまでできるんですね。何度も回答有難うございます！
参考になりました。
有難うございました。

回答No.5

tom04

こんばんは！
No.1です。

希望に添えるかどうか分かりませんが・・・
↓の画像のように無理矢理関数でやってみました。
Sheet1が元のデータで作業列として、I・J列を追加させてもらっています。
階層の部分が問題になると思いますので、Sheet2に表示させるために
Sheet1のI3セル　=IF(D3=2,ROW()-2,"")
Sheet1のJ3セル　=IF(D3=3,ROW()-2,"")
としてオートフィルで下へコピーしています。
このデータを利用して
Sheet2のD3セル　=IF(COUNT(Sheet1!$I$3:$I$10)>=ROW()-2,INDEX(Sheet1!$A$3:$A$10,SMALL(Sheet1!$I$3:$I$10,ROW()-2)),"")
E3セル　=IF(D3="","",VLOOKUP(D3,Sheet1!$A$3:$B$10,2,0))

G3セル　=IF(COUNT(Sheet1!$J$3:$J$10)>=ROW()-2,INDEX(Sheet1!$A$3:$A$10,SMALL(Sheet1!$J$3:$J$10,ROW()-2)),"")
H3セル　=IF(G3="","",VLOOKUP(G3,Sheet1!$A$3:$B$10,2,0))
A3セル　=IF(D3="","",ROUNDDOWN(D3,-3))
B3セル　=IF(A3="","",VLOOKUP(A3,Sheet1!$A$3:$B$10,2,0))
としてそれぞれオートフィルでコピーすると画像のような表示になります。

尚、属性名に関してはまったく考慮に入れていませんが、
手入力かVLOOKUP関数で対応できるかと思いました。

なんか無理矢理って感じがしますが
参考になれば幸いです。
画像が小さいかもしれませんが、読み取りにくかったら
画面を拡大してみてください。

的外れの回答なら読み流してくださいね。
どうも何度も失礼しました。m(__)m

回答No.3

myRange

おや？、図が貼り付けられてますね。
そして、最初のとはちょと違う。。。
それから、図が小さすぎて見え難いです。
こういうときは、２つに分けて別質問に投稿する手もありますね。
で、図の項目などは最初の質問から推測してのコードです。

（注意事項）
勘定科目のシート名：　勘定科目
階層一覧のシート名：　階層一覧
としてあります。

'-----------------------------------------
Sub Test()
　Dim i As Long
　Dim R As Long
　Dim Flag As Integer

'---- 階層一覧クリアー--------

　Sheets("階層一覧").Cells.Clear

'---- 階層一覧作成 --------

　Sheets("勘定科目").Select

　R = 2
For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
　Select Case Cells(i, "D").Value
　　Case 1
　　　　R = R + 1
　　　　Flag = 1
　　　　Sheets("階層一覧").Cells(R, "A").Resize(1, 3).Value = Cells(i, "A").Resize(1, 3).Value
　　Case 2
　　　　If Flag <> 1 Then R = R + 1
　　　　Flag = 2
　　　　Sheets("階層一覧").Cells(R, "D").Resize(1, 3).Value = Cells(i, "A").Resize(1, 3).Value
　　Case 3
　　　　If Flag <> 2 Then R = R + 1
　　　　Flag = 3
　　　　Sheets("階層一覧").Cells(R, "G").Resize(1, 3).Value = Cells(i, "A").Resize(1, 3).Value
　End Select
Next i

'--- 階層一覧の見出しと罫線の作成 ＆列幅設定----

Sheets("階層一覧").Select
Range("A1:C1").Merge
Range("D1:F1").Merge
Range("G1:I1").Merge
Range("A1,D1,G1").Value = Array("属性１", "属性２", "属性３")
Range("A1:I1").HorizontalAlignment = xlCenter
Range("A1:i1").Interior.ColorIndex = 6
Range("A2:C2").Value = Array("【科目No】", "【勘定科目名】", "【属性名】")
Range("D2:F2").Value = Array("【科目No】", "【勘定科目名】", "【属性名】")
Range("G2:I2").Value = Array("【科目No】", "【勘定科目名】", "【属性名】")
Range("A2:I2").HorizontalAlignment = xlCenter
Range("A2:i2").Interior.ColorIndex = 6
Columns("A:I").AutoFit
Range("A1", Cells(R, "I")).Borders.LineStyle = xlContinuous

End Sub
'-----------------------------------------------

なお、言わずもがなのことですが、
階層一覧シートに予め見出しや罫線が設定してあれば
後半の部分と、はじめの数行目にある、
Sheets("階層一覧").Cells.Clear
は不要になります。

また、一応、テスト済みですので、意図しない結果となった場合は
質問者の方に問題があることになります。。(^^;;;
以上ここまで。

お礼

myRange様
早速ありがとう御座います。
すみません、最初から図にすればよかったのですが、登録時の転記で間違えていました。しかも、図も小さくて・・・失礼しました。

ありがとう御座います。
試してみます！

回答No.2

myRange

マクロ（ＶＢＡ）なら簡単にできますが
ワークシート関数ではちょっと無理だと思います。
ＶＢＡでよければコードをアップします。

以上ここまで。

補足

myRange様
ありがとう御座います。
ぜひコードアップを御願い致します。
宜しく御願いします。

回答No.1

tom04

こんばんは！
質問の解釈が間違っていたらごめんなさい。

勝手に↓の画像のように表を作ってみました。
（属性名の欄は理解できなかったのでなにもしていません）

勘定科目名によってプルダウンリスト表示内容が選択できるようにしています。

画像の下側の表がSheet2になります。
Sheet2でそれぞれ範囲指定後に名前ボックスに入力していきます。

そしてSheet1の勘定科目をリスト表示させたいセルを範囲指定（列すべてでも構いません）し
メニュー　→　データ　入力規則　→　「入力値の種類」でリストを選択
「元の値」の欄に　=勘定科目名　としてOK

次に勘定科目名2の列を範囲指定　→　先ほどと同様にリストの「元の値」の欄に
=INDIRECT(A2)　としてOK

同じように勘定科目名3の列を範囲指定　→　リストの「元の値」の欄に
=INDIRECT(C2)　としてOK

これで「勘定科目名1」からリスト表示させていくと、前の勘定科目名に関する項目がプルダウンリストに表示されるようになります。

私か勝手に判断して回答していますので
的外れの回答なら読み流してくださいね。m(__)m

補足

tom04様早速のご回答ありがとう御座いました。
私の質問内容の説明不足＆質問が的確でなかったため、目的とは異なりましたが、とても参考になりました。ありがとう御座います。

再度イメージを掲載刺せて頂きます、お知恵お貸し下さい。
※ピポットテーブルも試してみましたが、階層2までしか作成することが出来ません。