特定範囲の合計を求める方法

質問

OFFICE2010

Ａ列に題目の文字列(文字列の長さは不定）
Ｂ列に価格としての数値データ
が入ったリストがあります（5000行くらい）
それぞれの題目の先頭には空白行が３桁入ったものと、6桁入った題目が存在している。
題目先頭空白3桁のものは、題目先頭空白6桁のもので構成されているイメージ。
このリストで、それぞれの題目先頭空白3桁のものの金額を算出したい。
合計金額の表示はＣ列で、題目先頭空白3桁と同行に配置したい。

下記の様なリストがあったとして
題目　　　　　　価格
　A001
　　　b001　　　　100
　　　c001　　　　 50
　 B001
　　　d002　　　　300
　　　e004　　　　500
　　　J009　　　 1000

下記の様に合計を表示したい
題目　　　　　　価格　　　合計
　A001　　　　　　　　　　150
　　　b001　　　　100
　　　c001　　　　 50
　 B001　　　　　　　　　1800
　　　d002　　　　300
　　　e004　　　　500
　　　J009　　 　1000
対応方法は、関数でもマクロでもどちらでも可です。
よろしくお願いします

回答No.1

watabe007 · ベストアンサー

マクロですが
Sub Test()
　　Dim c As Range, Start As Long

　　Start = 2
　　For Each c In Range("A2", Cells(Rows.Count, "A").End(xlUp))
　　　　If Left(c.Offset(1).Value, 6) <> Space(6) Or c.Offset(1).Value = "" Then
　　　　　　If Start < c.Row Then
　　　　　　　　Cells(Start, "C").FormulaR1C1 = "=SUM(R[1]C[-1]:R[" & c.Row - Start & "]C[-1])"
　　　　　　End If
　　　　　　Start = c.Offset(1).Row
　　　　End If
　　Next
End Sub

お礼

ありがとうございます。
ばっちりです。助かりました。

回答No.3

msMike

貴方の日本語が理解できないので確認させてください。
「空白行が３桁」とはどういう意味ですか？
「空白行」とは文字通り「空白の行」であって、桁数もヘッチャもないでしょう？

補足

失礼しました。
空白行が３桁は、空白が３桁の誤記です。

回答No.2

imogasi

こういうデータだと、Ｅｘｃｅｌやアクセスの分類や集計向けでない。
（ソート、フィルタ、検索、集計などに置いて）
修正表を作らないとむつかしい。
修正したデータを作って、そしてピボットテーブルに持ち込むことだ。エクセル分類・集計の最大のツールですよ。
「題目」のデータのあり様が詳細が不明（空白に見えている部分が、半角か全角かＴＡＢかなど。）
プログラムをやらないと、この辺のことがわからず、大切と考えて、詳しく書けないだろう。
下記は、その点を勝手に考えて、決めてサンプル例でやったが。
例データ　Ａ２：Ｂ１２
Ａ列＝コード　Ｂ列＝計数
A001
b001　　 1
c001 　　1
B001
d002　　 2
e004　　 3
J009　　 4
C001
d002　　 5
e004　　 6
J009　　 7
ーー
標準モジュールに
ActiveSheet.Columns(2).Insert　’Ｂ列に列章入
ActiveSheet.Columns(2).Insert　’Ｂ列に列章入
For i = 2 To 100000　’最大１０万行仮定
If Cells(i, "A") = "" Then Exit Sub　’Ａ列セルで空白セルまで繰り返し
x = Cells(i, "A")
For j = 1 To Len(x)
If Mid(x, j, 1) <> " " Then　'Ａ列で非空白文字の位置探索
p = j - 1
'---
If p = 3 Then
bunrui1 = Trim(Cells(i, "A"))
Rows(i).EntireRow.Delete
End If
If p = 6 Then
Cells(i, "B") = bunrui1
Cells(i, "C") = Trim(Cells(i, "A"))
End If
End If
Next j
p1:
Next i
End Sub
ーー
結果　下記のような、データにしないと、後処理がやりにくいのだ。
大分類 小分類 計数
b001　　A001　b001　　1
c001 　A001　 c001　　 1
d002　　B001　d002 2
e004　　B001 e004 3
J009　　B001　J009 4
d002　　C001　d002 5
e004　　C001　e004 6
J009　　C001　J009 7
ピボットで
行ラベル 合計 / 計数
A001 2
b001 1
c001 　　1
B001 9
d002 2
e004 3
J009　 4
C001 18
d002 5
e004 6
J009　 7
総計 　　29
ーー
　質問のようなデータに、システム部担当者がもし、したのなら、ＥＵＣを行う者に対する、思慮が足りないと思う。

補足

修正表を作らないとむつかしい。
→その通りです

「題目」のデータのあり様が詳細が不明
→
失礼しました。半角です

修正表のイメージから、作業列を設定し、下記の様に対応しました。
D1セル：先頭空白文字桁数
E1セル：代表題目
F1セル：グループ
D2セル：=LEN(A2)-LEN(SUBSTITUTE(SUBSTITUTE(A2,"　","")," ",""))
E2セル：=IF(D2=3,SUBSTITUTE(SUBSTITUTE(A2,"　","")," ",""),"")
F2セル：=IF(AND(D2=3,(SUBSTITUTE(SUBSTITUTE(A2,"　","")," ",""))=E2),E2,F1)

2行目の内容を最終行までフィルダウン
以上により
題目　　　　　価格　　　合計　先頭空白文字数　代表題目　グループ
　A001　　　　　　　　150　　　　　　　　3　　A001　　A001
　　　b001　　　100　　　　　　　　　　　6　　　　　　　A001
　　　c001　　　 50　　　　　　　　　　　　6　　　　　　A001
　 B001　　　　　　　　1800　　　　　　　3　　　B001　B001
　　　d002　　　300　　　　　　　　　　　6　　　　　　　B001
　　　e004　　　500　　　　　　　　　　　6　　　　　　　B001
　　　J009　 　1000　　　　　　　　　　　6　　　　　　　B001