セルに名前をつける

質問

excel2003

セルに名前を付与するマクロで繰り返し処理する設定を教えていただきたく。

構成：
Ｄ１２からＤ３６のセルまで１行おきに名前をつけたい名称が１３ケ登録されています
結合されたセルが
（１）AG11:AH12、AG13:AH14、AG15:AH16…AG35:AH36 全部で１３ケ
（２）AI11:AJ12、AI13:AJ14、AI15:AJ16…AI35:AJ36　全部で１３ケ
存在します

（１）のセル名称はＤ１２を参照し先頭には_CKC_を付加、末尾には_1を付加
（２）のセル名称はＤ１２を参照し先頭には_CKC_を付加、末尾には_0を付加

という内容を下記のマクロで作成しました。

Sub Sample1()

Dim name1 As String
Dim name2 As String
Dim name3 As String
Dim name4 As String
Dim name5 As String
Dim name6 As String
Dim name7 As String
Dim name8 As String
Dim name9 As String
Dim name10 As String
Dim name11 As String
Dim name12 As String
Dim name13 As String

name1 = Range("D12")

Names.Add name:="_ckc_" & name1 & "_0", RefersTo:="=$AG$11"
Names.Add name:="_ckc_" & name1 & "_1", RefersTo:="=$AI$11"

name2 = Range("D14")

Names.Add name:="_ckc_" & name2 & "_0", RefersTo:="=$AG$13"
Names.Add name:="_ckc_" & name2 & "_1", RefersTo:="=$AI$13"

name3 = Range("D16")

Names.Add name:="_ckc_" & name3 & "_0", RefersTo:="=$AG$15"
Names.Add name:="_ckc_" & name3 & "_1", RefersTo:="=$AI$15"

name4 = Range("D18")

Names.Add name:="_ckc_" & name4 & "_0", RefersTo:="=$AG$17"
Names.Add name:="_ckc_" & name4 & "_1", RefersTo:="=$AI$17"

name5 = Range("D20")

Names.Add name:="_ckc_" & name5 & "_0", RefersTo:="=$AG$19"
Names.Add name:="_ckc_" & name5 & "_1", RefersTo:="=$AI$19"

name6 = Range("D22")

Names.Add name:="_ckc_" & name6 & "_0", RefersTo:="=$AG$21"
Names.Add name:="_ckc_" & name6 & "_1", RefersTo:="=$AI$21"

name7 = Range("D24")

Names.Add name:="_ckc_" & name7 & "_0", RefersTo:="=$AG$23"
Names.Add name:="_ckc_" & name7 & "_1", RefersTo:="=$AI$23"

name8 = Range("D26")

Names.Add name:="_ckc_" & name8 & "_0", RefersTo:="=$AG$25"
Names.Add name:="_ckc_" & name8 & "_1", RefersTo:="=$AI$25"

name9 = Range("D28")

Names.Add name:="_ckc_" & name9 & "_0", RefersTo:="=$AG$27"
Names.Add name:="_ckc_" & name9 & "_1", RefersTo:="=$AI$27"

name10 = Range("D30")

Names.Add name:="_ckc_" & name10 & "_0", RefersTo:="=$AG$29"
Names.Add name:="_ckc_" & name10 & "_1", RefersTo:="=$AI$29"

name11 = Range("D32")

Names.Add name:="_ckc_" & name11 & "_0", RefersTo:="=$AG$31"
Names.Add name:="_ckc_" & name11 & "_1", RefersTo:="=$AI$31"

name12 = Range("D34")

Names.Add name:="_ckc_" & name12 & "_0", RefersTo:="=$AG$33"
Names.Add name:="_ckc_" & name12 & "_1", RefersTo:="=$AI$33"

name13 = Range("D36")

Names.Add name:="_ckc_" & name13 & "_0", RefersTo:="=$AG$35"
Names.Add name:="_ckc_" & name13 & "_1", RefersTo:="=$AI$35"

End Sub

付与したい名称が１３ケであれば、上記の通りベタでも対応可能ですが、
付与したいセルが多くなった時、ベタで対応するのは大変なので、
Ｎケの名前を付与させるマクロを教えていただきたく。

マクロ初心者なので、ＶＢＡはベタで教えてください。

回答No.1

keithin · ベストアンサー

sub macro1()
　dim r as long
　dim c as integer

　for r = 11 to 35 step 2
　　for c = 0 to 1
　　　cells(r, c * 2 + 33).name = "_CKC_" & cells(r + 1, "D").value & "_" & c
　　next c
　next r
end sub

ぐらいで十分です。

お礼

回答ありがとうございます。大変助かりました。