Excelの目次作成のマクロ

質問

Excel 2000 で本の目次を作りたいと、思いネットで下記ののようなマクロを見つけました。

Sub 索引作成()
　　Dim R As Range, R2 As Range, LastFound As Range
　　Dim Found As Boolean
　　Range("C2", Range("D65536").End(xlUp).Offset(1, 0)).Clear
　　For Each R In Range("A2", Range("A65536").End(xlUp))
　　　　Found = False
　　　　Set LastFound = Range("C65536").End(xlUp)
　　　　For Each R2 In Range("C2", LastFound)
　　　　　　If R2.Value = R.Value Then
　　　　　　　　R2.Offset(0, 1).Value = R2.Offset(0, 1).Value & "," & R.Offset(0, 1).Value
　　　　　　　　Found = True
　　　　　　End If
　　　　Next
　　　　If Found = False Then
　　　　　　LastFound.Offset(1, 0) = R.Value
　　　　　　LastFound.Offset(1, 1) = R.Offset(0, 1).Value
　　　　End If
　　Next
End Sub

このマクロを使うと下記のような結果になるのですが、頁数の桁が多い場合（1000ページ以上）や、項目名の重複が多い場合は上手く動きません。

　A　　　　B　　　　C　　　　D
項目名　　頁
A　　　　　1
B　　　　　2
C　　　　　3
D　　　　　4
A　　　　　5
B　　　　　6
C　　　　　7
D　　　　　8
　　↓上記マクロを使うと
　A　　　　B　　　　C　　　　D
項目名　　頁
A　　　　　1　　　　A　　　　1,5
B　　　　　2　　　　B　　　　2,6
C　　　　　3　　　　C　　　　3,7
D　　　　　4　　　　D　　　　4,8
A　　　　　5
B　　　　　6
C　　　　　7
D　　　　　8
となりますが、頁が1000桁以上になると
A B　　　　　　C　　　　　D
項目名　　頁
A　　　　　1000　　　　A　　　　100,010,04
B　　　　　1001　　　　B　　　　100,110,05
C　　　　　1002　　　　C　　　　100,210,06
D　　　　　1003　　　　D　　　　100,310,07
A　　　　　1004
B　　　　　1005
C　　　　　1006
D　　　　　1007
のようになります。

頁が1000桁以上になる場合や、項目名の重複が多くなる場合でも上手く動くマクロは無いものでしょうか。
何卒、宜しくお願いいたします。

回答No.1

n-jun · ベストアンサー

＞Range("C2", Range("D65536").End(xlUp).Offset(1, 0)).Clear
の次に
Columns("D:D").NumberFormatLocal = "@"
を入れるとか？

お礼

早速の御回答有り難うございます。
御指摘頂戴しました「Columns("D:D").NumberFormatLocal = "@"」を元のマクロに加えて動作確認致しました。
質問させて戴きました、誤作動は見られず正常に目次が作れるようになりました。
御回答して戴きましたこと実に感謝しております。
有り難う御座いました。