Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7全般 : Excel 2010)
表の変換について
投稿日時: 18/04/16 21:28:53
投稿者: 軟太郎

初めて質問させて頂きます。
 
表の変換をするVBAコードを検討していますが、処理手順で悩んでおります。
何かアドバイス頂けたらと思いご質問させて頂きます。
 
レベル    品目マスタ    品目名称 員数        Assy1のリスト                
A    A000001-0000    Assy1    1        品目マスタ    品目名称 Assy2    Assy5    員数
B    B000A01-0001    Assy2    1        C001111-0000    部品A     〇    〇    4
C    C001111-0000    部品A    1        C002222-0000    部品B     〇    〇    1
C    C001111-0000    部品A    1        C003333-0000    部品C     〇    〇    1
C    C001111-0000    部品A    1        C00B0B0-0000    Assy3     〇        1
C    C001111-0000    部品A    1    ⇒    D000101-0000    部品D     〇        1
C    C002222-0000    部品B    1        D000202-0000    部品E     〇        1
C    C003333-0000    部品C    1        C000C0C-0000    Assy4     〇        1
C    C00B0B0-0000    Assy3    1        D003210-0000    部品F     〇        1
D    D000101-0000    部品D    1        C00B0B0-0000    Assy6        〇    1
D    D000202-0000    部品E    1        D001101-0000    部品G        〇    1
C    C000C0C-0000    Assy4    1        D010202-0000    部品H        〇    1
D    D003210-0000    部品F    1        C00D0E0-0000    Assy7        〇    1
B    B000B01-0001    Assy5    1        D004560-0000    部品I        〇    1
C    C001111-0000    部品A    1                        
C    C001111-0000    部品A    1                        
C    C001111-0000    部品A    1                        
C    C001111-0000    部品A    1                        
C    C002222-0000    部品B    1                        
C    C003333-0000    部品C    1                        
C    C00B0B0-0000    Assy6    1                        
D    D001101-0000    部品G    1                        
D    D010202-0000    部品H    1                        
C    C00D0E0-0000    Assy7    1                        
D    D004560-0000    部品I    1                        
 
<処理条件>
1)同じ部品の行が有れば、1行にまとめ員数を変更する
2)元表のレベルの優先順位がA(親)からB(子)・C(孫)・D(曾孫)の順で
 子以下の孫を行にする(レベルAの親は変換後リストのタイトル)
3)レベルB(子)を基準に同列のBでレベルC(孫)を比較し、列側に〇に変換
 
上記処理条件のうち、1)は何とかなりましたが、2)・3)をこの後どう処理すれば良いのかで悩んでいます。
アドバイスお願い致します。
 
Sub test2()
    Dim strCell As String
    Dim i, j, k As Long
    Dim LastCell As String
    Dim rngCell As Range
    Dim strAAA As Variant
     
    Sheets(1).Select
    i = 2: j = 3: k = 1
    LastCell = Cells(Rows.Count, j).End(xlUp).Row
    strCell = Cells(i, j).Offset(1, 0).Value
     
    Dim LoopTime As Long
     
    For LoopTime = LastCell To 2 Step -1
        If Cells(LoopTime, j).Value = strCell Then
            k = k + 1
            Cells(LoopTime, j).Offset(0, 1).Value = k
            Cells(LoopTime, j).Offset(1, 0).EntireRow.Delete
        Else
            k = 1
        End If
        strCell = Cells(LoopTime, j).Value
    Next LoopTime
     
    j = 1: k = 1
    LastCell = Cells(Rows.Count, j).End(xlUp).Row
             
    For LoopTime = LastCell To 2 Step -1
        If Cells(LoopTime, j).Value = "B" Then
            strAAA = Cells(LoopTime, j).Address
        End If
    Next LoopTime
 ’ この後2)の処理で
  Cell.Find(what:="B"),Cells.FindNext(what:="B")で検索すれば良いのか?と思っていますが
  検索後、どのように〇表にするか??です。
 
End Sub
 
 

回答
投稿日時: 18/04/16 23:10:39
投稿者: WinArrow
投稿者のウェブサイトに移動

すみません
右の表のイメージが理解できません。
 
 
 
部品(子)別、Assy(親)別の個数を集計したいのではないかと
推測して、
 
A列   B列  C列
B:Assy2 C:部品A 員数
B:Assy2 C:部品B 員数
B:Assy2 C:部品C 員数
B:Assy3 C:部品D 員数
B:Assy3 C:部品E 員数
B:Assy4 C:部品F 員数
B:Assy5 C:部品A 員数
B:Assy5 C:部品B 員数
C:Assy6 D:部品G 員数
C:Assy6 D:部品H 員数
 
このような表を作成すれば、ピボットテーブルで集計できると思いますが・・・・
 

回答
投稿日時: 18/04/17 07:28:17
投稿者: simple

(1)同一のBレベル配下の、C,Dレベルについて、その重複を除いた一覧を作ります。
   ・それぞれの品目マスタをKeyとして、
   ・書込先の行番号(連番を自動設定します)をItemとした
   Dictionaryを作成するとよいでしょう。
(2)もういちど元表を順に読みながら、それぞれの品目に対応するBレベルの欄に○をつけていきます。
(3)その過程のなかで、品目名称と員数も書き込みます。
という方針で臨んではどうでしょうか。
 
ところで、疑問点ですが、
(Q1)
 C001111-0000 部品A については、どのBレベル配下でも、同一の4という員数なんですか?
 違った場合は、どうするのですか?
(Q2)
サンプルのアウトプット例を見ると、DレベルのあとにCレベルが表示されていますね。
>元表のレベルの優先順位がA(親)からB(子)・C(孫)・D(曾孫)の順で
という要件に合致していないようですが、そこはどのように整理されているのですか?
C,Dは同一優先度ということですか?

回答
投稿日時: 18/04/17 16:05:34
投稿者: mattuwan44

┌──────┬──────┬──────┬────┬──┐
│           1│           2│           3│品目名称│員数│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│            │            │Assy1   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│            │Assy2   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C002222-0000│部品B   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C003333-0000│部品C   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C00B0B0-0000│Assy3   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│D000101-0000│部品D   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│D000202-0000│部品E   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│C000C0C-0000│Assy4   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000A01-0001│D003210-0000│部品F   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│            │Assy5   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C001111-0000│部品A   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C002222-0000│部品B   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C003333-0000│部品C   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C00B0B0-0000│Assy6   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│D001101-0000│部品G   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│D010202-0000│部品H   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0000│B000B01-0001│C00D0E0-0000│Assy7   │   1│
├──────┼──────┼──────┼────┼──┤
│A000001-0024│B000B01-0001│D004560-0000│部品I   │   1│
└──────┴──────┴──────┴────┴──┘

 
こういう表なら、
ピボットテーブルで、
 
┌──────┬────┬──────┬──────┬──┐
│合計 / 員数 │        │           2│            │    │
├──────┼────┼──────┼──────┼──┤
│           3│品目名称│B000A01-0001│B000B01-0001│総計│
├──────┼────┼──────┼──────┼──┤
│C000C0C-0000│Assy4   │           1│            │   1│
├──────┼────┼──────┼──────┼──┤
│C001111-0000│部品A   │           4│           4│   8│
├──────┼────┼──────┼──────┼──┤
│C002222-0000│部品B   │           1│           1│   2│
├──────┼────┼──────┼──────┼──┤
│C003333-0000│部品C   │           1│           1│   2│
├──────┼────┼──────┼──────┼──┤
│C00B0B0-0000│Assy3   │           1│            │   1│
├──────┼────┼──────┼──────┼──┤
│C00B0B0-0000│Assy6   │            │           1│   1│
├──────┼────┼──────┼──────┼──┤
│C00D0E0-0000│Assy7   │            │           1│   1│
├──────┼────┼──────┼──────┼──┤
│D000101-0000│部品D   │           1│            │   1│
├──────┼────┼──────┼──────┼──┤
│D000202-0000│部品E   │           1│            │   1│
├──────┼────┼──────┼──────┼──┤
│D001101-0000│部品G   │            │           1│   1│
├──────┼────┼──────┼──────┼──┤
│D003210-0000│部品F   │           1│            │   1│
├──────┼────┼──────┼──────┼──┤
│D004560-0000│部品I   │            │           1│   1│
├──────┼────┼──────┼──────┼──┤
│D010202-0000│部品H   │            │           1│   1│
├──────┼────┼──────┼──────┼──┤
│総計        │        │          11│          11│  22│
└──────┴────┴──────┴──────┴──┘

 
こういう表が簡単に作れます。
提示のデータ量くらいなら簡単に手動で出来ますので、
それでマクロの記録をしてコードを調べるのはいかがでしょう。
それを元に詰まったところをここにテーマを絞って聞くのもありかなと。。。
 
あと、別案としては、
部品のユニークな一覧表は重複の削除で取得できるので、
それから、数式でCountIf等の関数で数えるのもありかなと、
そのために、元の表はどうあると簡単なのになぁ。。。と思うところを、
自動で編集するようにしたらいいと思います。
 
元の表だけから、希望の結果を取得するなら上から順にみて
Bが出てきたところで処理を分けるかんじですかねぇ。。。
 
 
 
 

投稿日時: 18/04/17 21:41:05
投稿者: 軟太郎

説明不足の感のある質問にご回答頂き、皆様ありがとうございます。
 
<WinArrow>さん

引用:
このような表を作成すれば、ピボットテーブルで集計できると思いますが・・・

 
ピボットテーブルを使用したことが無かったため、色々調べながらのトライで右表のように重複行のまとめはできるようなのですが、うまくVBAで行かず引き続きテストしてみます。
 
引用:

(Q1)
 C001111-0000 部品A については、どのBレベル配下でも、同一の4という員数なんですか?
 違った場合は、どうするのですか?
(Q2)
サンプルのアウトプット例を見ると、DレベルのあとにCレベルが表示されていますね。
>元表のレベルの優先順位がA(親)からB(子)・C(孫)・D(曾孫)の順で
という要件に合致していないようですが、そこはどのように整理されているのですか?
C,Dは同一優先度ということですか?

 
説明が不足して申し訳ございません。
<Q1の回答>
員数、及び左の表の行数は使用部品により変化します。そこで、いま考えているのは、各セルの値を配列に入れ
不要な行を削除(この時点で削除行をカウント)し、カウント値を員数に入れようかと実装中です。
 
<Q2の回答>
左表はVBAでCSVを読み込み、フォーマットが独特のため分かりづらく、申し訳ありません。
左表端のレベルが示す値でAssy2(レベルB)に使用する部品がレベルC群となり、下に列記されます。たとえばAssy3はその他のレベルC部品と同一レベルで、Assy3に使用する部品群はさらに部品Dと部品E(レベルD)で構成されます。
部品E(レベルD)の次行に出現するAssy3は前述のAssy2と同じレベルの部品Assyになり、Assy群によっては構成部品が2個のものもあれば複数個の場合もあります。
左表だと上記説明がぱっと見分かりづらくて右表を作成して列毎で分かるように右表のようにまとめるのがミッションでした。
 
<mattuwan44>さん
ご提示頂いた表の通りです。
分かりやすくデータ量を減らしたのですが、左表はVBA処理にてCSVで読み込んで処理するので
データ数がサンプル行の2〜3倍あり、またAssy2(レベルB)の出現回数も増えるのですが、ピボットテーブルで可能でしょうか?(ピボットテーブルを用いた処理を書いたことが無いので)
<WinArrow>さんからも同じご提案を頂いたので明日もピボットテーブルでトライしてみます。
 
 
 
 

回答
投稿日時: 18/04/17 22:17:06
投稿者: simple

最初に訂正。
 
誤(1)同一のBレベル配下の、C,Dレベルについて、その重複を除いた一覧を作ります。
正(1)同一のAレベル配下の、C,Dレベルについて、その重複を除いた一覧を作ります。
 
■(Q1)について再度、確認します。
Assy2の下にあるC001111-0000と、
Assy5の下にあるC001111-0000は必ず同じ員数4なんですか?
C001111-0000は必ず4と決まっているんですか?
 
Assy5の下にある員数が3 といったケースはないんですか?
もし、その場合、員数4と員数3はどこに記入されるんですか?
C001111-0000が2行立つんですか?
 
■(Q2)の回答を言い直すと、
レベルC,Dの順序は、そのまま集計表に転記すればよく、
ソートしてはならない、ということですね?
(ピボットテーブルはソートするのがデフォルトのようです)
 
■もう一つ確認。
C00B0B0-0000 Assy3
C00B0B0-0000 Assy6
というデータがあります。
このように同じコードで名称が異なることがあるんですか?
ユニークなコードではないんですか?
 

投稿日時: 18/04/18 05:14:55
投稿者: 軟太郎

<simpleさん>
 

引用:
■(Q1)について再度、確認します。
Assy2の下にあるC001111-0000と、
Assy5の下にあるC001111-0000は必ず同じ員数4なんですか?
C001111-0000は必ず4と決まっているんですか?
  
Assy5の下にある員数が3 といったケースはないんですか?
もし、その場合、員数4と員数3はどこに記入されるんですか?
C001111-0000が2行立つんですか?

 
すいません。回答しきれていませんでした。
Assy2とAssy5の直下にある部品A(C001111-0000)は4個とは限りません。
3個のケースもあれば、7個のケースもあります。
表の変換前に左表の時点で
Forループを最終行から先頭行方向へ名称と品目コードが一致した行が有ったら
当該行をカウントしてから行を削除し、員数にそのカウント値を入れる予定です。
 
引用:
■(Q2)の回答を言い直すと、
レベルC,Dの順序は、そのまま集計表に転記すればよく、
ソートしてはならない、ということですね?

 
左表と右表は出来ればソートせずに作成できる方法をと思います。
ただし理由は表の比較(デバッグ)がしやすいからということだけなので
Mustではなく、最悪ソートされても可です。(Better程度)
 
 
引用:
C00B0B0-0000 Assy3
C00B0B0-0000 Assy6
というデータがあります。
このように同じコードで名称が異なることがあるんですか?
ユニークなコードではないんですか?

 
申し訳ありません。データを簡易にするときに品目コード入力を間違えたみたいです。
上記例の場合、各々品目コードは異なります。
 
ピボットテーブルを希望通りに出来ず、条件探しに苦戦していて
マクロ記録すらたどり着いていない状態がもどかしいです。(・・・涙)
 

回答
投稿日時: 18/04/18 06:48:07
投稿者: simple

ご苦労様です。回答ありがとうございます。
ただ、

引用:
もし、その場合、員数4と員数3はどこに記入されるんですか?
C001111-0000が2行立つんですか?
という疑問にお答えいただいていません。
どのように表示したいのか、レイアウトで明確に回答願います。

回答
投稿日時: 18/04/18 09:07:33
投稿者: mattuwan44

>またAssy2(レベルB)の出現回数も増えるのですが、ピボットテーブルで可能でしょうか?
 
ここに出来る位の少ないデータで練習してみてはいかがですか??
質問者も回答側も同じデータで話が出来るとお互いに解りやすいと思います。
そのなかで、行き詰ったことを質問してみては?
実際の大きいデータだと、
質問者側も上手く説明できない場合もありますし、
回答側も想像力を働かせて回答したところで、
行き違いが起きてお互いに労力が必要になって、
解決に至らない等、質問者側が結局損をします。
 
とりあえず、部品Aがどの部品の配下に属するのかの情報を持っていれば、
そのうちのレベルBの情報を抜き出せば区別できるのではないですか?
エクセルでは1件1行でデータを入力してある前提で様々な機能が用意されています。
(ピボットテーブルやフィルター等)
提示された表では、1行内にその情報が無いので、
分けるのが難しくなります。
省略してある情報を付加してやることが肝要です。
どうせVBAを使うのですから、そういうことは自動でできますよね?
そして、エクセルVBAでは、他人が作ったプログラム(エクセル内のさまざまな機能や関数)が、
利用できます。
それらに任せられるところは任せた方が開発が楽になると思います。
 
もちろん、それらを使わないで、自分の好きなようにプログラムを組み立てることが可能なのが、
VBAのいいところですが
(他のアプリケーションなどは、用意された機能を順番に自動で実行される程度のマクロしか用意されてない)、
難しく考える必要もないかなと思います。
 
ただし、ピボットテーブルも癖が強いので、
ピボットテーブルを使わない手順を少し考えてみますね。

回答
投稿日時: 18/04/18 10:20:05
投稿者: mattuwan44

Sub Macro1()
'
' Macro1 Macro
'
 
'
    ActiveWindow.NewWindow
    Windows.Arrange ArrangeStyle:=xlVertical
    Windows("Book1:1").Activate
    With ActiveWindow
        .Width = 512.25
        .Height = 411.75
    End With
    Sheets("Sheet2").Select
    Windows("Book1:2").Activate
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$26").AutoFilter Field:=1, Criteria1:="<>A", _
        Operator:=xlAnd, Criteria2:="<>B"
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Book1:1").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$D$23").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlYes
    Windows("Book1:2").Activate
    ActiveSheet.Range("$A$1:$D$26").AutoFilter Field:=1, Criteria1:="=B", _
        Operator:=xlAnd
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("16:16").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.AutoFilter
    Range("C4:C15").Select
    Selection.Copy
    Windows("Book1:1").Activate
    Range("E1").Select
    ActiveSheet.Paste
    Windows("Book1:2").Activate
    Range("C17:C28").Select
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=-3
    Range("D10").Select
    Windows("Book1:2").Activate
    Range("C13").Select
    ActiveWindow.SmallScroll Down:=-8
    Windows("Book1:1").Activate
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Windows("Book1:2").Activate
    Range("C4").Select
    Selection.Copy
    Windows("Book1:1").Activate
    Range("D1").Select
    ActiveSheet.Paste
    Range("D2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet1!R5C3:R15C3,RC[-1])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D14")
    Range("D2:D14").Select
    Windows("Book1:2").Activate
    Range("C17").Select
    Selection.Copy
    Windows("Book1:1").Activate
    Range("E1").Select
    ActiveSheet.Paste
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet1!R[16]C[-2]:R28C3,RC[-2])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E14")
    Range("E2:E14").Select
    Range("E11").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet1!R[16]C[-2]:R28C3,RC[-2])"
    Windows("Book1:2").Activate
    Columns("B:B").EntireColumn.AutoFit
    Windows("Book1:1").Activate
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet1!R18C3:R28C3,RC[-2])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E14")
    Range("E2:E14").Select
    Range("E5").Select
    Windows("Book1:2").Activate
    ActiveWindow.SmallScroll Down:=-6
    Range("D1").Select
    Selection.Copy
    Windows("Book1:1").Activate
    Range("F1").Select
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F14")
    Range("F2:F14").Select
    Range("D2:E14").Select
    Selection.NumberFormatLocal = """○"";;;"
End Sub
 
一応マクロの記録が↑
このマクロをステップ実行してみながら解読してみてください、
参考URL>>
http://www.ken3.org/vba/excel-help.html
 
一応こちらの結果は、

┌───┬──────┬────┬───┬───┬──┐
│レベル│品目マスタ  │品目名称│Assy2 │Assy5 │員数│
├───┼──────┼────┼───┼───┼──┤
│C     │C001111-0000│部品A   │    ○│    ○│   8│
├───┼──────┼────┼───┼───┼──┤
│C     │C002222-0000│部品B   │    ○│    ○│   2│
├───┼──────┼────┼───┼───┼──┤
│C     │C003333-0000│部品C   │    ○│    ○│   2│
├───┼──────┼────┼───┼───┼──┤
│C     │C00B0B0-0000│Assy3   │    ○│      │   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D000101-0000│部品D   │    ○│      │   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D000202-0000│部品E   │    ○│      │   1│
├───┼──────┼────┼───┼───┼──┤
│C     │C000C0C-0000│Assy4   │    ○│      │   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D003210-0000│部品F   │    ○│      │   1│
├───┼──────┼────┼───┼───┼──┤
│C     │C00B0B0-0000│Assy6   │      │    ○│   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D001101-0000│部品G   │      │    ○│   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D010202-0000│部品H   │      │    ○│   1│
├───┼──────┼────┼───┼───┼──┤
│C     │C00D0E0-0000│Assy7   │      │    ○│   1│
├───┼──────┼────┼───┼───┼──┤
│D     │D004560-0000│部品I   │      │    ○│   1│
└───┴──────┴────┴───┴───┴──┘

このようになっていますので同じデータなら同じようになるはずです。
一部結果により目視で判断した部分がありますがそれは記録されないので、
そこは書き足すことになりますが、ご了承願います。
 
また、画面の分割やスクロールなど手動では目視で判断しなければいけないので、
そういう画面の操作や、セルの選択も記録されますが、
それらのほとんどは不要ですのでそれらもプロシージャの中から除外することになります。
参考になれば。。。

回答
投稿日時: 18/04/18 11:30:49
投稿者: mattuwan44

Sub test()
    Dim rngTable As Range
    Dim rngResult As Range
    Dim rngTaget As Range
    Dim r As Range
    Dim ixCol As Long
 
    Set rngTable = Sheets("Sheet1").Range("A1").CurrentRegion
    Set rngResult = Sheets("Sheet2").Range("A1")
 
    'ユニークな部品リスト作成
    With rngTable
        .AutoFilter Field:=1, Criteria1:="<>A", Operator:=xlAnd, Criteria2:="<>B"
        If Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Columns("B:C").Copy rngResult
            Set rngResult = rngResult.CurrentRegion
            rngResult.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
        End If
    End With
 
    'レベルB毎の処理
    With rngTable
        .AutoFilter Field:=1, Criteria1:="=B"
        Set rngTaget = Intersect(.Columns(1).SpecialCells(xlCellTypeVisible), .Offset(1))
        If rngTaget.Cells.Count > 1 Then
            For Each r In rngTaget.Cells
                r.EntireRow.Insert shift:=xlShiftDown
            Next
        End If
    End With
    Set rngTable = rngTable.Worksheet.UsedRange.SpecialCells(xlCellTypeConstants)
    ixCol = 3
    For Each r In rngTable.Areas
        If r(1).Value = "B" Then
            With rngResult.CurrentRegion
                .Cells(1, ixCol).Value = r(1, 3).Value
                Intersect(.Offset(1, ixCol - 1), .Columns(ixCol)).Formula = "=COUNTIF(" & r.Address(External:=True) & ",B2)"
            End With
            ixCol = ixCol + 1
        End If
    Next
    With rngResult.CurrentRegion
        .Columns(ixCol).Formula = "=Sum(" & .Rows(1).Address(False, False) & ")"
        .Cells(1, ixCol).Value = "員数"
        With .CurrentRegion
            .Resize(.Rows.Count - 1, .Columns.Count - 3).Offset(1, 2).NumberFormatLocal = """○"";;;"
        End With
    End With
     
    '元の表を元に戻す
    With rngTable.Worksheet.UsedRange
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .AutoFilter
    End With
End Sub

投稿日時: 18/04/18 22:02:33
投稿者: 軟太郎

<simpleさん>
 

引用:

C001111-0000 部品A については、どのBレベル配下でも、同一の4という員数なんですか?
 違った場合は、どうするのですか?
もし、その場合、員数4と員数3はどこに記入されるんですか?
C001111-0000が2行立つんですか?

 
すべて回答したつもりが未回答でした。こんな自分がお恥ずかしい限りです。(T_T)
改めてみると自分の回答が誤解を招く表現でした。
 
改めて訂正させてください。
 
サンプル右表の場合
品目マスタ    品目名称    Assy2    Assy5    員数
C001111-0000    部品A      〇    〇    4 
員数=4は可変しますが(←回答したつもりでいました)
Assy2の員数とAssy5の員数は常に同じ員数でした。(←これがご質問のことですよね?)
仮に員数がAssy2とAssy5で各々違う場合を想定していませんでしたが、違う場合は”〇”表示ではなく、セルに員数を各々記載するしか方法が無いかもしれません。
その条件判断は同一部品の行を削除するところで判定するしかないかと思います。
 

投稿日時: 18/04/18 22:08:32
投稿者: 軟太郎

<mattuwan44さん>
マクロ記録結果やサンプルコードご提示ありがとうございました。
本日ピボットテーブルで試行錯誤していたのですが、どうしてもAssyのかたまりとその下に各部品でしか表示できませんでした。きっと設定の方法が悪いのだと思います。
(ただ今回ピボットテーブルを使ったコードも書いてみて、大変参考になりました。今後の参考にさせて頂きます)
 
またご提示のサンプルコードでも記載頂いた表になることも確認できましたので、動作を確認しながら参考にさせて頂きます。
 
皆様のアイディアご提示、考え方のご指導&新たな発見で当方だいぶ糸口が見えた感がありますので
今後データが増えた際の処理等含め、コード実装してみます。
 
ご回答頂いた方々に感謝いたします。
 
取り急ぎ本件はここまででいったんCloseにさせてください。
また不明点が出ましたら、改めてご質問させて頂きます。
つたない説明にお付き合い頂き、ありがとうございました。