上下セルをくらべテキストに含まれる"."の数の増減で処理を分岐する

Question

製造業です。大きなアッセンブリの設計データから使われている部品の親子関係レベルと員数を出力できるのですが1つ上の親が1つの場合の個数しか子の個数がでてきません。

例えば一番上のレベル1を組み立てるために
1.1は1つ
1.1.1は2つ、
まではいいのですが1.1.1.1は1.1.1が2個必要なら以下すべて2倍の個数になってほしいのですが1.1.1が1個の場合の個数しか出力されません。

さらにその下1.1.1.2を構成する1.1.1.2.1と1.1.1.2.2は1.1.1.2の必要数4を×した数になります。孫に行くほどその親、その親の個数がかかってくるのです

下のリストの「必要数」が導き出したい数値です

レベル	員数	必要数
1	1	1
1.1	1	1
1.1.1	2	2
1.1.1.1	1	2
1.1.1.2	2	4
1.1.1.2.1	3	12
1.1.1.2.2	4	16
1.1.1.3	1	2
1.1.1.3.1	2	4
1.1.1.3.1.1	2	8
1.1.1.3.1.2	2	8
1.1.1.3.1.2.1	3	24
1.1.1.3.1.2.2	2	16
1.1.1.4	2	4

思い描く仕組みとしては一列目の”.”の数を数えて上下を比べ、増えるか減るかした場合直近の上方の”.”が-1個したの時の必要数を×(かける)、さらにその下のセルの”.”の数が変わらなかったら同じ親の必要数を×(かける)し続ける…

Sub innzuu()

Dim LstRow1 As Long
Dim i As Long, k As Long, m As Long, n As Long, o As Long
Dim Lv As Variant
Dim Lv2 As Variant
Dim Lv3 As Variant


LstRow1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row


For i = １ To LstRow1 Step 1

    'Lv変換
    Lv = Split(Sheet1.Cells(i, 1), ".") '.をいくつか数えて
    Lv2 = Split(Sheet1.Cells(i + 1, 1), ".")
     Lv3 = Split(Sheet1.Cells(i + 2, 1), ".")
       k = UBound(Lv) '数値化してkに代入
       m = UBound(Lv2)
       n = UBound(Lv3)
       o = Cells(i + 1, 2).Value
       
 If k < m Then
    Do While m = n
    Cells(i + 1, 3).Value = Cells(i, 1).Value * o

Loop

End If

Next i

End Sub

こんなかんじで、ちんぷんかんぷんしながらただ今検討中です。
初心者の自分ではかなり時間を要するのが目にみえているので同時にテラテイルに質問しておこうということで投稿いたしました。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

hatena19様

エラーが出てしまうところを抜粋してみました。尚、2.9の下が2.1となってしまっていますがこれは2.10の0が消えてしまったためで、できればこのケースは処理せず対応したいです。()内の数が求めたい結果です。

あと、余談ですがこちらは実際は791行で試したのですが最後の6行が空欄になっていました…がこれはまた別の話ですかね。ここまでデータを書き込むのは大変なので(汗)

レベル	員数	必要数
1	1	1
1.1	1	1
2	1	1
2.1	1	3
2.1.1	1	1(3)
2.1.2	1	1(3)
2.1.3	3	3(9)
2.2	1	1
2.3	1	1
2.4	2	2
2.5	1	1
2.6	1	1
2.7	1	1
2.8	1	1
2.9	3	3
2.1	3	4(3)
2.11	4	2(4)
2.12	2	2
3	2	8(2)
3.1	1	2

Answer 1

解決済みですが、参考までに。

1行目は項目名で2行目からデータが入力されているとします。

Public Sub test()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim i As Long, s As String
    For i = 2 To Cells(1, 1).End(xlDown).Row
        s = GetParent(Cells(i, 1).Text)
        If s = "" Then
            dic(Cells(i, 1).Text) = Cells(i, 2).Value
        Else
            dic(Cells(i, 1).Text) = dic(s) * Cells(i, 2).Value
        End If
    Next

    Cells(2, 3).Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)
End Sub

Public Function GetParent(s As String) As String
    Dim p As Long
    p = InStrRev(s, ".")
    If p = 0 Then
        GetParent = ""
    Else
        GetParent = Left(s, p - 1)
    End If
End Function

Comments

[kumiko]

ありがとうございます。実はまだ解決しておらず
質問をたてなおすべきなのかな？とおもっております。

dic(Cells(i, 1).Text) = dic(s) * Cells(i, 2).Value

のところで型が一致しない、とでてしまいました…。

[hatena19]

当方のサンプルでは質問のデータで問題なく動作してます。

そのエラーがでるときのデータを提示してもらえれば原因が分かるかもしれません。

[kumiko]

すみません、今日改めて実行したら「型が一致しない」というエラーは出なかったのですが結果がすこし求めるところと違うものが出てくるところがありました。質問のところに記載させていただきました。

[hatena19]

質問に追加の例ですが、
4行目の
2.1 1 3
で、必要数が3になるのはどのような計算仕様でしょうか。

> 尚、2.9の下が2.1となってしまっていますがこれは2.10の0が消えてしまったためで、できればこのケースは処理せず対応したいです。

これはエクセルのおせっかい仕様で、2.10 を少数と解釈して数値にしてしまうのが原因ですね。
対策法はないことはないですが、可能なら区切り記号を . (ピリオド)ではなく , (カンマ)などにすればそのような問題はなくなります。

> 余談ですがこちらは実際は791行で試したのですが最後の6行が空欄になっていました

これは、レベルに重複がないという前提(Dictionaryの仕様上)ですので、重複があるとその分データ数がへります。

[kumiko]

お世話になります

>4行目の
>2.1 1 3
>で、必要数が3になるのはどのような計算仕様でしょうか。
誤りでした。1ですね。するとその下のも変わってきますね。

＞これは、レベルに重複がないという前提(Dictionaryの仕様上)ですので、重複があるとその分データ数がへります。

なるほど、ここをしっかりしないと計算結果の出力もずれていくわけですね。

＞可能なら区切り記号を . (ピリオド)ではなく , (カンマ)などにすればそのような問題はなくなります。

アドバイスいただいた形で変換して実行してみたいと思います。
ありがとうございます。

[kumiko]

hatena19さんのコードもバッチリでした。
エクセルの数値化、やっかいですね。
テキストで出力してスプレッドシートで立ち上げて貼り付け、みたいなめんどくさいことになってます。
でもよく見たらベストアンサーのjinojiさんのコードもこの問題を解決しないとちょっとおかしなことになっていました。
大きなデータで試すとまた思いがけないことが起きますね。
わかってよかったです。ありがとうございました。

Answer 2

[C1]
=Keisan($A$1:$A$14,A1)

Function Keisan(rng As Range, s As String)
    Dim dic
    set dic = CreateObject("Scripting.Dictionary")

    Dim c As Range
    For Each c In rng
        dic(c.Text) = c.Offset( , 1).Value
    Next

    Dim v As Variant, p As String
    For Each v In Split( s , "." )
        If p = "" Then
            p = v
            Keisan = dic(p)
        Else
            p = p & "." & v
            Keisan = Keisan * dic(p)
        End If
    Next
End Function

Comments

[kumiko]

凄い！完璧です。
functionってユーザー定義関数みたいな使い方できるんですね。
みてもなんだかよくわからないのでちゃんとわかりたいです。よくみて勉強したいと思います。
ありがとうございました。

[jinoji]

簡単に説明すると、
For Nextのループが二つあるのがわかると思いますが、
まず１つ目のループで、連想配列というものを使って、レベルと員数の対応関係を 変数に格納しています。
dic("1") = 1 , dic("1.1") = 1 , dic("1.1.1")= 2　・・・ といった感じ。

2つ目のFor〜Next は、必要数を調べたいレベル、例えば "1.1.1.2.2" だったとしたら、
ピリオドで分割して、"1" "1" "1" "2" "2" として、それを変数vに順に取り出して処理します。
順に取り出したものを、前回までの分とくっつけたのが変数pで、
"1" "1.1" "1.1.1" "1.1.1.2" "1.1.1.2.2" となっていきます。
それをdic(p)のように最初に作った連想配列のキーにすることで、各レベルの員数を取得して、
順に乗算していく、と言った具合です。

・・・すみません、あんまり簡単じゃないかも。
ステップ実行で処理を追っていくとだんだんわかってくるかもしれないので、頑張ってみてください。

[kumiko]

すみません、別の表で同じようにやったのですがなぜか０が多発してしまって…。
上の表ではしっかり動いているのになにが違うのか…お分かりになりますでしょうか。
可能でしたらご解答おねがいいたします。

[kumiko]

問題のところに別の表と出力結果を記載しました

[kumiko]

ほんとーにごめんなさい！いったんベストアンサー外させてください。申し訳ありません！m(__)m

[jinoji]

多分数式の引数を入れ間違えているのだと思います。$が抜けてるとか。

[kumiko]

わかりました！ごめんなさい。何度も。
設計データから出力したデータがちょっと変わっていて？
一見「1.1.5.1」と表示されているのにセルをダブルクリックすると
1.1.5
.1
というふうにへんなところで改行がはいってしまってました。そういうところの数値がすべて０になってしまう。
なってるところとなっていないところがあってうまくいってるところといかないところがあって切ったりはったりしばらく悩みました…。

こちらの問題でした。ほんとすみません。コードはやっぱり完璧でした。
ありがとうございました。

[jinoji]

解決してよかったです。
ちなみにコードの中で改行を除去するなら以下のように直す手もあります。ご参考まで。
For Each c In rng
dic(WorksheetFunction.Clean(c.Text)) = c.Offset(, 1).Value
Next
s = WorksheetFunction.Clean(s)

[kumiko]

ありがとうございます！