エクセルVBAマクロですこし変わった合計の方法

質問

添付画像左のように、A列に１～４、4(1）～(3)までナンバーが記入されており、B列C列には数値が含まれているとき、（　）が存在している場合のみ（　）が存在しないナンバー（例の場合は４）のB列C列に（　）があるナンバー（例の場合(1)～(3)）の合計を添付画像右がわのように表示させたいとき、どのようなマクロを組めばできますでしょうか。

全てお願いしてしまいますと、コードも長くなってくるのではないかと思われますので、画像では入力シートから表示シートに切り替わっているということですが、入力シートの空白セルへの表示でもかまいません。
（　）つきナンバーのB～後の値を（　）なしナンバーのB～後に合計できる方法をお教え頂ければ幸いです。

回答No.3

n-jun · ベストアンサー

No．２です。

Sub try()
Dim myDic As Object
Dim r As Range
Dim v As Variant
Dim vv As Variant

' Dictionaryオブジェクトをセット
Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("入力用")

' 入力用シートのＡ１～Ａ最終セルまでを取得
For Each r In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))

' Ａ列の値を"("で区切る
v = Split(r.Value, "(")
' その後、区切った中から添字:0の値を利用するけど、
' "4(1)"の時は"4"を得られるし、"1"の時は"1"となる。

' もしv(0)の値がDictionaryのキーに存在しない時は、
If Not myDic.Exists(v(0)) Then

' アイテムとしてＡ・Ｂ・Ｃ列の値をArray関数を用いて代入する。
myDic(v(0)) = Array(v(0), r.Offset(, 1).Value, r.Offset(, 2).Value)

' もしキーに存在したならば
Else

' 変数：vvにそのアイテムを一旦代入する。
vv = myDic(v(0))

' vvの添字:0（B列の値を格納）は数字となっているので、
' Val関数を用いてそれを数値に変換し、
' さらにB列の値を足して代入しなおす。
vv(1) = Val(vv(1)) + r.Offset(, 1).Value

' vvの添字:1（C列の値を格納）についても同様。
vv(2) = Val(vv(2)) + r.Offset(, 2).Value

' そのキーのアイテムとして再度代入しなおす。
myDic(v(0)) = vv
End If

Next

End With

With Worksheets("表示")

' 表示シートのＡ～Ｃ列の値をクリア。
.Range("A:C").ClearContents

' Ａ１を基準にDictionaryに存在するキーの個数分と
' Ａ～Ｃの列数分についてセル範囲をResizeし、
' Dictionaryのアイテム（１次元配列）を２次元配列で
' 出力するために、Transpose関数を２重に実行する。
.Range("A1").Resize(myDic.Count, 3).Value = _
Application.Transpose(Application.Transpose(myDic.Items))

End With
Set myDic = Nothing

End Sub

Dictionaryオブジェクトについては少し書き方が違いますが、
こちらが参考になるかと。

Excel(エクセル) VBA入門：Dictionaryオブジェクトを利用する
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html

お礼

丁寧なコメントを入れて頂いた上に、参考にできるサイトも教えて頂き、ありがとうございます。

回答No.2

n-jun

Sub try()
Dim myDic As Object
Dim r As Range
Dim v As Variant
Dim vv As Variant

Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("入力用")

For Each r In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))

v = Split(r.Value, "(")

If Not myDic.Exists(v(0)) Then
myDic(v(0)) = Array(v(0), r.Offset(, 1).Value, r.Offset(, 2).Value)
Else
vv = myDic(v(0))
vv(1) = Val(vv(1)) + r.Offset(, 1).Value
vv(2) = Val(vv(2)) + r.Offset(, 2).Value
myDic(v(0)) = vv
End If

Next

End With

With Worksheets("表示")

.Range("A:C").ClearContents

.Range("A1").Resize(myDic.Count, 3).Value = _
Application.Transpose(Application.Transpose(myDic.Items))

End With
Set myDic = Nothing

End Sub

一例になれば。

お礼

回答して頂きありがとうございました。

補足

ご連絡が遅くなり申し訳ありません。
思惑の事ができましたが、当方初心者すぎる余り、どこでどの作業を行っているのかうまく理解できておりません。
Arrayで格納しておいて表示シートのA～Cの値を削除して書き出しているというのはわかるんですが・・・。
作成して頂いた上に贅沢を言って申し訳ないのですが、もしよろしければこの場所でこの作業をしているというコメントをつけて頂けませんでしょうか。

回答No.1

tom04

こんばんは！
A列で単に数値は「親番」・（）付の数値はその「子番」だとして
すべて親番に集計する！という解釈です。
※　（）付のデータの前の数値は上の行の「親番」
（途中に他の「親番」が含まれていない）という前提です。
お示しのようにデータは1行目からあるとして・・・

Sub test()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Not IsNumeric(Cells(i, 1)) Then
Cells(i - 1, 2) = Cells(i - 1, 2) + Cells(i, 2)
Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3)
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？
※　「子番」のデータは削除するようにしていますので
別Sheetでマクロを試してみてください。

参考になりますかね？m(_ _)m

お礼

回答して頂きありがとうございました。
参考にさせて頂きます。

補足

ご連絡が遅くなり申し訳ありません。
思惑の事ができましたが、当方初心者すぎる余り、どこでどの作業を行っているのかうまく理解できておりません。
しかし、A1に（　）つきの文字を入れるとデバッグが発生することから、A1の表示形式？でチェックをしていき、同じならそのまま、違ったら上のセルに足して消す。
という処理を行っていると考えればいいのでしょうか？