こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

 はじめまして。検索して同種の問題が見当たらなかったため、質問させてください。

 エクセルで、別シートを参照しているセルの調査と抽出を手作業で行っています。
 シートの中には別シートのセルを参照・計算しているセルと、同一シート内での計算のみを行っているセルがあります。法則のあるものもないものもあり、数百行を検索と目視でまかなっております。
 これが 数十ファイル×十数シート あり、手作業に時間の足りなさとつらさを感じ始めております……

 エクセルのシートの中で、別シートを参照しているセルの抽出を行いたいです。
 セルの色を変更し、セル名(A17 など)とセルの値(='Bシート'!A17 など)を別のファイルなどに出力したいんです。
 イメージとしては、数式として「!」を検索したときの検索結果と同じだと思うんですが、検索ではセル名と値をコピーができなかったために困っています。

 どなたかご教授いただければと思います。よろしくお願いします。


 おまけ。
 上記のリストアップ後、リンクの設定されたセルの色付けを行います。参照元のシートごとに色をかえて、見やすくまとめられたら嬉しいなぁと思います。
 でもこちらは、リストアップが終わればその後に手作業でもできますので、蛇足ということで……

投稿日時 - 2007-06-14 12:05:40

QNo.3083665

困ってます

質問者が選んだベストアンサー

こんにちは。

以下のマクロは、新たな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

投稿日時 - 2007-06-14 13:50:40

お礼

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

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

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

投稿日時 - 2007-06-14 14:48:31

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

こんにちは。#1です。

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

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


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

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

Sheet2のA、B,C,D列にそれぞれ、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

投稿日時 - 2007-06-14 18:49:50

補足

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

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

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


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

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

投稿日時 - 2007-06-14 19:01:28

お礼

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

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

投稿日時 - 2007-06-15 14:11:27

あなたにオススメの質問