エクセル小僧：参照先セルを選択

選択されているセルの参照先を選択し、参照先セルのセル数とアドレスをメッセージボックスに表示するマクロを作成しました。


【条件】
・マクロ実行前に参照元セルを選択しておく。
・マクロ実行後、参照先セルが選択されている。
・参照先セルが無い場合、その旨、メッセージボックスに表示する。



・参照先セルのセル数、アドレスをメッセージボックスに表示する。セル数が多い場合、先頭の数セルのみ、アドレスを表示する。



【マクロ】
' 【機能】選択されているセルの参照先を選択
Sub MsSdd1()
  '【変数】
  Dim myRange1(2) As Range ' Range型
  Dim myDPCount As Long ' 参照先セル数
  '【実行コード】
  On Error GoTo myError
  Application.ScreenUpdating = False ' 画面更新停止
  Set myRange1(0) = Range(Selection.Address) ' 選択されているセルを代入
  Set myRange1(1) = Selection.DirectDependents ' 参照先セルを代入
  ' 参照先セル数が1セル以上だったら実行
  myDPCount = Selection.DirectDependents.Count ' 参照先セル数
  If myDPCount >= 1 Then
    ' 参照先セルを選択し、左上へスクロールする
    Application.Goto myRange1(1), True
    With ActiveWindow
      .ScrollRow = myRange1(1).Range("A1").Row
      .ScrollColumn = myRange1(1).Range("A1").Column
    End With
    ActiveWindow.SmallScroll Up:=0, ToLeft:=4
  End If
  Application.ScreenUpdating = True ' 画面更新再開
  MsgBox myRange1(0).Address & "の参照先セル数=" & myDPCount & vbCrLf _
  & "(" & UFStrLenCut1(myRange1(1).Address, 30) & ")"
  Exit Sub
myError:
  MsgBox "選択したセル(" & myRange1(0).Address & ")の参照先は、ありません。"
  Application.ScreenUpdating = True ' 画面更新再開
End Sub

' 【機能】文字列の長さを指定された数字以下に整形
Function UFStrLenCut1(ByVal str1 As String, ByVal num1 As Long) As String
  '【引数】
  ' str1 : 文字列
  ' num1 : 文字数
  '【実行コード】
  If Len(str1) > num1 Then
    UFStrLenCut1 = Left(str1, num1) & "・・・"
  Else
    UFStrLenCut1 = str1
  End If
End Function

【解説？】
参照先セルが無い場合の処理は、エラーで処理しています。

タグ：エクセル VBA DirectDependents LEFT 参照先

コメント 1

ヤバイぜ!　ありがとうございます[__猫]
by cheese999 (2016-07-26 05:45)