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
お礼
kmetu様 有難うございます。各列それぞれ指示で出来ました。