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

質問

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

回答No.1

x0000x · ベストアンサー

こんにちは。

以下のマクロは、新たなBOOKのマクロに貼り付けで実行します。
このマクロでは、指定したBOOKをOPENし、book内の全シートについて、"!"を検索します。
検索結果は"Sheet2"に出力しています。

BOOK名、出力シート名を適当に置き換えて実行してみてください。

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 = "式"

Dim bk As Workbook
Workbooks.Open ("C:\test.xls")
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, "=", "") '式 =を外す

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

Set oSt = Nothing

MsgBox "検索終了!"

End Sub

お礼

まさにイメージ通りです、ありがとうございます！
　２０００とか２万行の抽出結果が出て、感激もひとしおです。

　一つお聞かせいただければと思いますが、このときにシート名だけを抜き出したりすることは可能なのでしょうか。
　もしシート名だけを抜き出したり、シート名ごとに色や処理を変えることができるなら頑張りたいです。

　あとはどうにか、数十ファイルを対応するために……ファイル名と出力シート名を引数で可変にすればいいのかな？
　マクロは不慣れなもので、どう指定すればいいかよく分かりませんが試行錯誤してみます。本当にありがとうございました。