エクセルで別シートを参照しているセルのリストアップ方法

質問

• エクセルで別シートを参照しているセルの抽出方法について解説します。手作業でセルを調査・抽出する必要がありますが、数百行もある場合は時間がかかります。セルの色を変更し、セル名と値を別のファイルに出力することで効率的に処理することができます。
• セルの色を変更してセル名と値を出力する方法を紹介します。セル名や値は数式として「!」を検索すると表示されますが、コピーすることはできません。手作業でリストアップするのは大変なので、この方法を使って効率的に抽出しましょう。
• 抽出したセルの値を別のファイルに出力し、セルの色付けを行うことで見やすく整理することができます。参照元のシートごとに色を変えることで、さらに見やすくなります。リンクが設定されたセルについても色付けすることができます。

回答No.2

x0000x

こんにちは。＃１です。

>このときにシート名だけを抜き出したりすることは可能なのでしょうか。

シート一覧のイメージ？でしょうか？
可能です。
処理中のシート名は「 st.Name 'Sheet名」で取得できます。
どのように表示するか不明なので以下では「'★シート単位の処理」で示す位置にコードを追加してください。

>シート名ごとに色や処理を変えることができるなら頑張りたいです。
セルの色設定は、
st.cells(行,列).Interior.ColorIndex = 6 '色付け
で可能です。(行、列はシート名を格納したセル位置に変えてください）
上記でシート名を抜き出したセルの背景色が変更できます。
ただし、シートすべてに別々の色をつけるのは無理です。
上記のコードでは、40色（白含む）程度です。

>数十ファイルを対応するために……ファイル名と出力シート名を引数で可変にすればいいのかな？
Sheet1のA2～AnにBOOKのPATHを文字列で設定することで
連続処理するのであれば、以下のマクロでどうでしょうか？
'変更前をコメント化し、'追加、'変更後を新たに記述しています。

Sheet2のＡ、Ｂ，Ｃ，Ｄ列にそれぞれ、BOOK名、Sheet名、セル名、式を表示します。

Sub findLink()

Dim oSt As Worksheet
Set oSt = Sheets("Sheet2")
oSt.Cells.Clear
' oSt.Range("A1").Value = "Sheet名" '変更前
' oSt.Range("B1").Value = "Cell名" '変更前
' oSt.Range("C1").Value = "式" '変更前
oSt.Range("A1").Value = "BOOK名" '変更後
oSt.Range("B1").Value = "Sheet名" '変更後
oSt.Range("C1").Value = "Cell名" '変更後
oSt.Range("D1").Value = "式" '変更後

Dim outCnt As Long '変更後
outCnt = 0 '変更後

Dim iSt As Worksheet '追加
Set iSt = Sheets("Sheet1") '追加

'BOOKファイルの定義最大行位置取得 '追加
Dim maxRowIST As Long '追加
maxRowIST = iSt.Cells(iSt.Rows.Count, "A").End(xlUp).Row '追加

Dim R As Long '追加
For R = 2 To maxRowIST '追加

Dim bk As Workbook
' Workbooks.Open ("C:\test.xls")　　'変更前
Workbooks.Open (iSt.Cells(R, "A").Value) '変更後
Set bk = ActiveWorkbook

Dim st As Worksheet
' Dim outCnt As Long '変更前
' outCnt = 0 '変更前

For Each st In bk.Sheets

'★シート単位の処理
Dim stopAddr As String
Dim rng As Range

Set rng = st.Cells.Find(what:="!", LookIn:=xlFormulas)
If Not rng Is Nothing Then

stopAddr = rng.Address

Do
outCnt = outCnt + 1 '出力件数カウント

' oSt.Cells(outCnt + 1, "A").Value = st.Name 'Sheet名　 '変更前
' oSt.Cells(outCnt + 1, "B").Value = rng.Address 'セル名 '変更前
' oSt.Cells(outCnt + 1, "C").Value = "'" & rng.Formula '式 '変更前
' ' oSt.Cells(outCnt + 1, "C").Value = Replace(rng.Formula, "=", "") '式 =を外す '変更前
oSt.Cells(outCnt + 1, "A").Value = bk.Name 'BOOK名 '変更後
oSt.Cells(outCnt + 1, "B").Value = st.Name 'Sheet名 '変更後
oSt.Cells(outCnt + 1, "C").Value = rng.Address 'セル名 '変更後
oSt.Cells(outCnt + 1, "D").Value = "'" & rng.Formula '式 '変更後
' oSt.Cells(outCnt + 1, "C").Value = Replace(rng.Formula, "=", "") '式 =を外す

rng.Interior.ColorIndex = 6 '色付け

Set rng = st.Cells.FindNext(rng) '次を検索

If rng Is Nothing Then
Exit Do '発見できないので終了
End If
Loop While (stopAddr <> rng.Address) '最初に発見したセルと同じなので終了

End If

Set st = Nothing

Next

bk.Close (True) '上書き保存

Set bk = Nothing

Next '追加

Set oSt = Nothing

MsgBox "検索終了!"

End Sub

お礼

その後、各種の問題が出つつもなんとか調査が進んでおります。
　ご丁寧にありがとうございました。

　もしよろしければ、また詰まったときにご教授いただければと思います。

補足

わざわざありがとうございます。
　また、説明の足りてないところがあり申し訳ありません。

　#1でいただいたソースを元に、以下の通り修正を行って実行してみました。
・　マクロを保存したブックのシート１に、エクセルのファイル名（ファイル一覧）を記述し、ファイル名と出力先のシート名（ファイル名に通し番号をつけ、30バイトでカット）を引数にループで findLink の関数を呼ぶ関数を作って実行。
・　マクロを保存したブックに、上記引数のシート名で、５０ファイル分の結果（５０シート）を出力することができた。

　このときやりたかったことが、調査対象のエクセルファイルのセルが、どこのシートを参照していたかの「参照元シート名を抜き出したい」ということでした。説明不足で申し訳ありません。
　シート間の関連性を調査しているため、どこのシートの値を参照していたかが知りたい状態です。
　でも検索後のシート名の抽出がよくわからなかったため、断念しております。

　返答遅れて申し訳ありません。
　自分のほうで試行錯誤し、やっと動いて結果が抜き出せた……ところで、なぜかエクセルファイルが開かなくなりました。マクロでワークシートのコピーとか色々してみましたが、オープンもできずに応答なしになるようです。とほほ。

　また、教えてくださったソースを元に色々頑張ってみます。どうもありがとうございました。