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. |キーワード|・・・・・・・・ _________________________________ | |ABC |・・・・・・・・//一列ロック | |EFG |・・・・・・・・//ロックなし | |DDD |・・・・・・・・//ロックなし | |ABC |・・・・・・・・//一列ロック | |ABC |・・・・・・・・//一列ロック _________________________________ (レイアウト崩れてたら申し訳ありません。) 感覚的にはこのような形です。 言葉間違いがありましたね。 >表(5列) →表(5行)です。 申し訳ありません。 >キーワードが並んでいるのが縦なのか横なのか、ロックをかけるのが >列(縦)なのか行(横)なのかよくわかりませんね。 キーワードは縦、ロックをかけるのは該当キーワードのある列(横)です。 >とりあえず、縦(例ではB列)にキーワードが並んでいて、該当するも >のがあったら、その行(横)をロックするというように勝手に解釈し >ました。 その解釈で問題ございません。 >キーが一致するのを一行だけに限定してもいいのか、複数行一致する >可能性があるのか不明でしたので、複数行にも対応しているので、サ >ンプルは少々複雑になっています。 複数行で可能性があります。 >(最後の処理の .Range("X1" & I).Locked = False などがどのセル >を指定 >したいのか不明なので省略してます。 このままだとX15とかにな >る。) 表のカラム数が多いため、最終的にはAC16まで表が伸びる予定です。 最後の処理は、キーワード検索に引っかかった一列をロック、その後対象セルのみをロック解除して操作可能にしようと考えました。 (「入力可能セルを制限させようとしています。」 大事な部分を書き忘れておりました。大変失礼しました。)