不規則エリアの連続計算方法（VBA)

質問

度々お世話になっております。
エクセルVBA勉強中の初心者です。

現在、下記のような数値データが入力されています。
処理したいのは、

A列・・・・・・・・・・・・処理後B列
1行目　空白・・・・・・空白
2行目　1・・・・・・・・・・・1
3行目　2・・・・・・・・・・・2
4行目　3・・・・・・・・・・・3
5行目　4・・・・・・・・・・・4
6行目　5・・・・・・・・・・・5
7行目　空白・・・・・・空白
8行目　1・・・・・・・・・・・6→第一エリア目の最終行と足し算
9行目　3・・・・・・・・・・・8→同上
10行目　4・・・・・・・・・・・9→同上
11行目　6・・・・・・・・・・・11→同上
12行目　空白・・・・・・空白
13行目　2・・・・・・・・・・・13　→第二エリア目の最終行と足し算
14行目　4・・・・・・・・・・・15　→同上
15行目　7・・・・・・・・・・・18　→同上
　・　　　　　　　　 　　　　　　　・
　・　　　　　　　　　 　　　　　　・
各エリアは、各1000行程度、エリアの数は、10～20になるため、どうしてもVBAで処理したいと考えております。
（空白～空白をエリアと名付けています。）

各エリアの数、行数ともに区々ですが、最大値を迎えた後、空白行が必ず入るようにデータが入力されています。

このようなデータをVBAで処理したいのですが、可能なのでしょうか？
参考書、過去ログなどを見てあれこれやってみたのですが、パニック状態です。
わかりにくい質問で恐縮ですが、良い方法をご教授いただければ幸いです。

宜しくお願いいたします。

回答No.2

hige_082 · ベストアンサー

おはよう御座います
回答でてるようですが、折角早起きして作ったので
'----------------------------------------------------
Sub test()
Dim カウンタ As Integer
Dim B列, 加算数 As Integer
B列 = 0
加算数 = 0
For カウンタ = 1 To Range("a65536").End(xlUp).Row
If Cells(カウンタ, 1).Value = "" Then
加算数 = B列
Else
B列 = Cells(カウンタ, 1).Value + 加算数
Cells(カウンタ, 2).Value = B列
End If
Next カウンタ
End Sub
'----------------------------------------------------
参考になればどうぞ

お礼

hige_082様

ご回答ありがとうございました。
シンプルにまとめて頂き、とても分かりやすいです。
いろいろと応用出来そうです！
今後とも宜しくお願いいたします。

回答No.4

mitarashi

奇を衒ったコードです。VBAのお勉強の種にはなるかも．．．
Sub test()
Dim myCell As Range, topRange() As Range, bottomRange() As Range
Dim i As Long

i = 1
Set myCell = Range("a2")
If myCell.Value = "" Then Exit Sub
Do
ReDim Preserve topRange(1 To i)
ReDim Preserve bottomRange(1 To i)
Set topRange(i) = myCell
If myCell.Offset(1, 0) <> "" Then Set myCell = myCell.End(xlDown)
Set bottomRange(i) = myCell
Set myCell = myCell.End(xlDown)
i = i + 1
Loop Until myCell.Row = ActiveSheet.Rows.Count
For i = 1 To UBound(topRange)
If i = 1 Then
Range(topRange(i), bottomRange(i)).Offset(0, 1).FormulaR1C1 = "=RC[-1]"
Else
Range(topRange(i), bottomRange(i)).Offset(0, 1).FormulaR1C1 = "=RC[-1]+" & Format(bottomRange(i - 1).Offset(0, 1).Value, "0")
End If
Range(topRange(i), bottomRange(i)).Offset(0, 1).Value = Range(topRange(i), bottomRange(i)).Offset(0, 1).Value
Next i
End Sub

お礼

mitarashi様

ご回答ありがとうございました。
とても勉強になります。考え方で色々なコードが書けますね。
現段階では理解するのが難しいですが、これからじっくりと勉強させていただきます。
ありがとうございました！

回答No.3

mt2008

VBAを使わない方法を、
B2に
=IF(A2="","",MAX(B$1:B1)+(A2-A1))
を入れて下までコピー。

1000行程度ならこの方が後のメンテナンスまで考えると楽だと思います。

お礼

mt2008様

ご回答誠にありがとうございました。
問題なく動作いたしました！勉強になります！
ただ、今回の件に限っては、測定器から自動入力されてきたデータをVBAで処理～グラフ化迄、一連処理したかったので、VBAにこだわりました。
関数でもVBAでもすらすらとコードが書けるように日々勉強いたします。
ありがとうございました！

回答No.1

n-jun

もっとスッキリな方法があるでしょうが。。。

Sub try()
Dim rr As Range, rs As Range
Dim ch As Boolean, i As Integer

ch = False

For Each rr In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlTextValues).Areas
For Each rs In rr

If ch = False Then
rs.Offset(, 1).Value = rs.Value
ch = True
Else
rs.Offset(, 1).Value = rs.Value + i
End If

Next
i = rr.Offset(, 1).Item(rr.Cells.Count).Value
Next

End Sub

こんな感じとか？

お礼

n-jun様

おはようございます。
早速のご回答、誠にありがとうございました。
ばっちり作動いたしました！全然すっきりです！
ステップインしながらコードの意味をじっくりと理解してみます。
助かりました！