Excel VBA 計算範囲の変更について教えてください。

質問

こんばんは。とても困っています。
下記のような表で=A1&B1&C1の計算式を入れ、A1とB1を絶対参照にして$A$1&$B$1&C1としてD3までオートフィルをかけます。
そしてD4は =$A$4&$B$4&C4のように絶対参照しているセルを変更したいのです。たくさんありすぎて参照する範囲を変更するのにとても大変な思いをしています。VBAでどのようにすればよいのか教えてください。

　　|A　　　　B　　　C　　　　　D
-------------------------------------
1| 1T　　11L　　　A　　　　1T11LA (=$A$1&$B$1&C1)
2|　　　　　　　　　　B　　　　1T11LB (=$A$1&$B$1&C2)
3|　　　　　　　　　　C　　　　1T11LC (=$A$1&$B$1&C3)
4|　2T　　20L　　　A　　　　2T20LA (=$A$4&$B$4&C4)
5|　　　　　　　　　　B　　　　 2T20LB (=$A$4&$B$4&C5)
6|　　　　　　　　　　C 　　　2T20LC (=$A$4&$B$4&C6)
7|　3T　　31M　　　A　　　　3T31MA (=$A$7&$B$7&C7)
8|　　　　　　　　　　B　　　　 3T31MB (=$A$7&$B$7&C8)

マクロで記録させたらところ下記のようになりました。
Sub 4行置きに参照範囲を変更する()
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-3]&RC[-2]&RC[-1]"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=R1C1&R1C2&RC[-1]"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D3"), Type:=xlFillDefault
Range("D1:D3").Select
Range("D4").Select
ActiveCell.FormulaR1C1 = "=R4C1&R4C2&RC[-1]"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:D6"), Type:=xlFillDefault
Range("D4:D6").Select
Range("D7").Select
ActiveCell.FormulaR1C1 = "=R7C1&R7C2&RC[-1]"
Range("D7").Select
Selection.AutoFill Destination:=Range("D7:D9"), Type:=xlFillDefault
Range("D7:D9").Select
End Sub
◎初心者なのでVBAにたくさんコメントを入れていただくと助かります。
宜しくお願い致します。

回答No.2

kmetu · ベストアンサー

Sub test()

Dim i As Integer, j As Integer, k As Integer

j = 0
k = 1

For i = 1 To Range("C65536").End(xlUp).Row
'c列の1行からデータの入っている最後の行数までの回数ループ
Range("D" & i).Formula = "=$A$" & k & "&$B$" & k & "&C" & i
j = j + 1
If j = 3 Then
k = k + 3
j = 0
End If

Next i

End Sub

でいかがでしょう。

回答No.3

winarrow07

下記でどうでしょう。できるだけ短いコードで。
コメントを付けるような複雑なこともやってません。

Sub Sample()
Dim i,j As integer
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row Step 3
　　For j = 0 To 2
　　　　Cells(i + j, 4).Formula = "=$A$" & i & "&$B$" & i & "&C" & i + j
　　Next j
Next i
End Sub

<条件>
C列に必ずA,B,Cがあること(AだけやA,Bで終わったりしない)

回答No.1

n-jun

Ｃ列の最終行までが範囲としたら、

Sub try()
Dim r As Range
Dim rr As Range

For Each r In Range("C1", Cells(Rows.Count, 3).End(xlUp))

If r.Offset(, -2).Value <> "" Then
Set rr = r.Offset(, -2)
End If

r.Offset(, 1).Formula = "=" & rr.Address & "&" & rr.Offset(, 1).Address & "&" & r.Address(0, 0)

Next

Set rr = Nothing
End Sub

こんな感じとか？