第36回目 エクセルのファイルを分析する(その2)

○第36回目　エクセルのファイルを分析する(その2)

　前回の問題提起の整理
　1.各シート名だけではなく、そのシートの概要を記したコメントも張り付ける。
　　(各シートのA1にそのシートの説明を必ずコメントで記入する)
　2.このコメントをテキストエディタで作成し、クリップボード経由で自動的に各シートのA1に貼り付ける。
　という2点でした。

　1.について
　各シートのコメントを配列変数値に格納すればほぼおしまいです。そのやり方ですね。
　結構調べましたが、操作マクロも参考にして、おおむね次のようになりました。
　これはコメントの取得と貼付けの両方となっています。

Range("E5").Select
Set cellcmt = ActiveCell.Comment　　'ここがポイント。set文を使う
If cellcmt Is Nothing Then
　　 mm = ""
Else
　　 mm = Cells(5, 5).Comment.Text
End If

Cells(15, 5).Select
Set cellcmt = ActiveCell.Comment　　'ここがポイント。set文を使うのでした
If cellcmt Is Nothing Then
　　 Cells(15, 5).AddComment
　 Cells(15, 5).Comment.Text Text:=mm
Else
　 Cells(15, 5).Comment.Text Text:=mm
End If


　この取得の部分を、for　to で包めば完成です
For i = 1 To Worksheets.Count 'シートの数だけ繰り返す。グラフは除く
:
:
Next


コメントは、指定した列に入れておきましょう。
ll005は5という定数の意。

Dim mm(100)　　'コメント
Dim nn(100)　　'グラフを入れてのシート番号

'コメントを入れる列の指定
　　h1 = InputBox("コメントを入れる列を入れてください。", , "i")
　　h2 = Range(h1 & "1").Column

'コメントの取得
For i = 1 To Worksheets.Count 'シートの数だけ繰り返す。グラフは除く
Worksheets(i).Select
nn(i) = ActiveSheet.Index
Cells(1, 1).select
　　 Set cellcmt = ActiveCell.Comment
　　 If cellcmt Is Nothing Then
　　　　 mm(i) = ""
　　 Else
　　　　 mm(i) = Cells(1,1).Comment.Text
　　 End If
Next

'コメントを貼り付ける
Worksheets(1).Select
For i = 1 To Worksheets.Count 'シートの数だけ繰り返す。
Cells(lr005 + nn(i) - 1, h2) = mm(i)
Next

よく考えると、これは単独のマクロが使い勝手がいいようです。
また、どこに貼り付けたらいいのかを与えたほうがいいと思います(対応済みです)。
シート名を貼り付けるマクロを原形として、コメント張り付けマクロをつくってみてください。
　※グラフのコメントは手で注記(コメント)を書いていくしかないでしょう。
　※ワークシートだけでのシート番号を取得するのが出来ません。上記で取得しているのは、グラフを含めた番号となっています。ワークシートの全体の数は、Worksheets.Countで取得可能なのにです。


　2.について
　クリップボードの内容を貼り付けます。
Cells(20, 5).PasteSpecial Operation:=xlPasteAll '貼り付ける
　でよろしいようです。

　しかし、実際には手動で貼り付けて、その範囲を指定した後にマクロを動かすというほうが良いようです。

'座標の取得
AAA = Selection.Address
p1 = InStr(AAA, ":")
AAA1 = Left(AAA, p1 - 1)
AAA9 = Mid(AAA, p1 + 1)
retu1 = Range(AAA1).Column
gyo1 = Range(AAA1).Row
retu9 = Range(AAA9).Column
gyo9 = Range(AAA9).Row

gyo_cnt = gyo9 - gyo1 + 1
retu_cnt = retu9 - retu1 + 1

'コメントの取得
For i = 1 To gyo_cnt
For j = 1 To retu_cnt
mm(i) = mm(i) & Cells(gyo1 + i - 1, retu1 + j - 1) & ","
Next j
Next i

'貼り付けたコメントの削除
Range(AAA).ClearContents

'コメントをA1に貼付け
For i = 1 To Worksheets.Count 'シートの数だけ繰り返す。グラフは除く
Worksheets(i).Select
Cells(1, 1).select
Set cellcmt = ActiveCell.Comment　　'ここがポイント。set文を使うのでした
If cellcmt Is Nothing Then
　　 Cells(1, 1).AddComment
　 Cells(1, 1).Comment.Text Text:=mm(i)
Else
　 Cells(1, 1).Comment.Text Text:=mm(i)
End If
Next
Worksheets(1).Select

　これでまあまあでしょうか。