VBAのコードに関する質問です。

質問

以下のコードで実行しているのですが上手くデータ数のカウンタが上手くいきません。助言をお願いしたいです。

Range("D2").Select
ActiveCell.Formula = "=0.001*C2+D1"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & fin), Type:=xlFillDefault
Range("D2:D" & fin).Select

Dim i As Long, j As Long, flg As Boolean
Dim i1 As Long

j = 1
For i = 2 To Cells(Rows.count, 2).End(xlUp).Row
If Cells(i, 2) = 2 Then
flg = True
ElseIf Cells(i, 2) = 3 And flg = True Then
i1 = i
Cells(1, 7) = i - 1
Cells(j, 5) = Cells(i, 4)
Cells(j, 6) = Cells(i - 1, 4)
flg = False
Exit For
Else: flg = False
End If
Next

For i = i To Cells(Rows.count, 2).End(xlUp).Row
If Cells(i, 2) = 2 Then
flg = True
ElseIf Cells(i, 2) = 3 And flg = True Then
j = j + 1
Cells(j, 7) = i - i1 - 2
i1 = i
Cells(j, 5) = Cells(i, 4)
Cells(j, 6) = Cells(i - 1, 4)
flg = False
Else: flg = False
End If
Next

Range("E1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Cells(1, 5) = Cells(2, 4)
Cells(Rows.count, 6).End(xlUp).Offset(1).Value = _
Cells(Rows.count, 4).End(xlUp).Value

Cells(Rows.count, 7).End(xlUp).Offset(1).Value = 200

Range("H1").Select
ActiveCell.Formula = "=(F1-E1)/G1"
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:H16"), Type:=xlFillDefault
Range("H1:H16").Select

Range("E1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Dim rowStr As Long, rowEnd As Long

Dim A, D, Da, H, K '演算：K=D-Da-H*A
Dim cntS As Integer, cntA As Integer
Dim cntD As Integer, cntH As Integer
Dim r As Long, t As Long

rowStr = 2 '開始行
rowEnd = Cells(Rows.count, 7).End(xlUp).Row 'G列で最終行を求める

cntS = 1 '周期初期値
cntD = rowStr 'D列行数初期値
cntH = rowStr 'H列行数初期値

For r = rowStr To rowEnd
cntA = rowStr
For t = 1 To Cells(r, 7) '各周期の繰り返し処理
A = Cells(cntA, 1).Value
D = Cells(cntD, 4).Value
If t = 1 Then
If r = rowStr Then
Da = 0 '1周期目は0とする
Else
'2週期目以降は最初の値に固定
Da = Cells(cntD, 4).Value
End If

'周期の区切りをF列に出力
Cells(cntD, 11).Value = cntS & "周期"
End If
H = Cells(cntH, 8).Value
K = D - Da - H * A '演算
Cells(cntD, 10).Value = K
cntA = cntA + 1 'A列カウンタ更新
cntD = cntD + 1 'D列カウンタ更新
Next t
cntS = cntS + 1 '周期カウンタ更新
cntH = cntH + 1 'H列カウンタ更新
Next r

回答No.1

OrangeCup150 · ベストアンサー

コードだけ記載しても何がしたいのかくみ取れません。
処理対象のデータの列数（項目）と行数
処理内容と期待する処理結果を明記してください。

なんとなく解析のたぐいをしていることは読み取れますが・・・。

補足

すいません、
これはA列に状態を表す数字（1～4）、B列に各状態での値が入っています。
状態が2の時の値を抽出し（順番に1.2となっている）、それぞれの試行の間（2と2の間）のデータ数を求め、それぞれの試行で平均をとり補正をかけるという処理を行っています。

いま、データ数をカウントするとこが上手くいかず、ずれが生じてしまっています。そこの原因と改善策を教えてほしいです。