Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10799 / 76734 ←次へ | 前へ→

【71480】Re:リンク元セルの選択
発言  kanabun  - 12/3/9(金) 21:00 -

引用なし
パスワード
   ▼おぢちゃん さん: こんにちは〜
よこから 確認だけ スミマセン。

>sheet1の多数のセルから同一ブック内の他の複数シートに向けて"リンク貼り付け"がされています。
>sheet1のリンク貼り付け"元"となっているセルに一括で色をつけたいのですが,

(確認)
簡単のため、3枚の[Sheet1] [Sheet2] [Sheet3] があるとすると、
[Sheet1] 
  リンク元 シート

[Sheet2] このシートに Sheet1 への参照がある
 たとえば、 [B2:B100] = "=Sheet1!A2"
  
[Sheet3] このシートにも Sheet1 への参照がある
 たとえば、 [C2:C100] = "=Sheet1!B2"
  
ということでよろしいですか?

もしそうだとすると、難しいですねぇ
たとえば、Sheet1 内のセルを順にLoopして、そのセルが どこか他の
セルから参照されているかを調べる DirectDependents プロパティが
あります。
Sub try1()
  Dim c As Range, r As Range
  
  With Sheet1.UsedRange
    .Interior.ColorIndex = xlNone
    For Each c In .Cells  'Sheet1 内をループ
      On Error Resume Next
      Set r = c.DirectDependents 'cセルを参照しているセル
      On Error GoTo 0
      If Not r Is Nothing Then
        c.Interior.ColorIndex = 6
        Set r = Nothing
      End If
    Next
  End With
End Sub
これを実行すると、Sheet1自身のどこかから参照のあるセルには
色がつきますが、そうでなく、別シートから参照されているセルには
残念ながら色がつきません。
------------------------------------------------------
DirectDependents プロパティは作業中のシートでのみ有効で、
リモート参照をトレースできないことに注意してください。
------------------------------------------------------
手動で、Sheet1の [A2]セルをアクティブにして、
[ツール]-[ワークシート分析]-[参照先のトレース]で調べたときは
Sheet2から Sheet1のA2 セルへの参照があるので、ちゃんと
別シートのアイコンが出て、Sheet1の[A2]からそのアイコンへ
矢印が描かれていたんですけどね。

よくわからないけど、力技で、
Bookの(Sheet1 以外の)すべてのシートをLoop して、
各シートの「数式の入っている」すべてのセルをしらみつぶしに
調べていって、 そこに "=Sheet1!A2" とかあれば、
Sheet1!A2 セルを色塗する、という方向(別シート、参照先から
Sheet1のリンク元セルを特定する)でなら、時間はかかるけれど
出来そうな気がします。(かぶりますが)
Sub try2()
  Dim ws As Worksheet
  Dim c As Range, r As Range, rs
  Dim Ad$, ThisSheetname$, ss$
  Dim dic As Object
  Dim j As Long
  
  '------- 対象シートをアクティブにして実行 ------
  Set dic = CreateObject("Scripting.Dictionary")
  ThisSheetname = "=" & ActiveSheet.Name & "!"
  For Each ws In Worksheets
    If ws.Name <> ThisSheetname Then
      On Error Resume Next
      For Each c In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
        ss = c.Formula
        j = InStr(ss, ThisSheetname)
        If j > 0 Then dic(Mid$(ss, j + 1)) = Empty
      Next
    End If
  Next
  If dic.Count Then
    ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
    For Each rs In dic.Keys()
      Excel.Range(rs).Interior.ColorIndex = 33
    Next
  End If
  
End Sub

5 hits

【71475】リンク元セルの選択 おぢちゃん 12/3/9(金) 8:30 質問
【71476】Re:リンク元セルの選択 n 12/3/9(金) 12:54 発言
【71482】Re:リンク元セルの選択 n 12/3/9(金) 23:00 発言
【71478】Re:リンク元セルの選択 ちん 12/3/9(金) 15:23 発言
【71492】Re:リンク元セルの選択 ちん 12/3/11(日) 23:23 発言
【71479】Re:リンク元セルの選択 UO3 12/3/9(金) 16:57 回答
【71480】Re:リンク元セルの選択 kanabun 12/3/9(金) 21:00 発言
【71484】Re:リンク元セルの選択 おぢちゃん 12/3/10(土) 1:31 発言
【71481】Re:リンク元セルの選択 UO3 12/3/9(金) 22:46 発言
【71483】Re:リンク元セルの選択 おぢちゃん 12/3/10(土) 1:06 発言
【71485】Re:リンク元セルの選択 hint 12/3/10(土) 9:28 発言
【71494】Re:リンク元セルの選択 hint 12/3/12(月) 20:59 発言

10799 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free