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桁以上になる場合や、項目名の重複が多くなる場合でも上手く動くマクロは無いものでしょうか。
何卒、宜しくお願いいたします。
お礼
本当にありがとうございました。 ””を３個入れてみたのですが、エラーとなってしまったので、４個目はやりませんでした。 ３個入れれば(数えて３個ならOKと思い込み)よいと思ったのです。 ですから非常に助かりました。