【ExcelVBA】指定した位置に表示範囲ごとアクティブセルを移動する

行・列番号またはセルアドレスを指定して移動する

ワークシート上でアクティブセルを移動するには、マウスかキーボードの矢印キー、もしくはショートカットキーを使いますよね。
でも縦横に長い表組とか(業務でありがち)で、先頭や末端以外の中間のセルには移動しにくい…
いっそ100行目とかAB列とかBX10とか直接指定して移動したい！って場合向けのマクロです。

普段は自分用のアドインに入れてCtrl＋Lのショートカットキーを設定して使っています。
エディタのノリで移動できてとても便利です。
アドインファイルの作り方とかはこの辺でざっと解説しています。
【Excel】シート名を部分一致で検索するアドインを作る

機能

ダイアログに移動先を入力すると、表示画面上の位置は変えずにアクティブセルを指定した場所に移動します。
画面上でのアクティブセルの位置は変わらず、シートだけをスクロールする感じ。
入力値が移動先として妥当でない場合、何もしないで処理を終了します。
なお、全角/半角、大文字/小文字は中で変換しているので、気にせず入力できます。

• 行番号を指定する場合、数字(列位置は変更なし)
• 列番号を指定する場合、アルファベット(行位置は変更なし)
• セルを指定する場合、A1形式のセルアドレス

※ Z100:AZ200みたいな単一セルではなく範囲を指定した場合、範囲の左上のセルに移動します。

ソースコード

' 指定した行番号・列番号にアクティブセルを移動する
Sub FocusCell()
    Application.ScreenUpdating = False
    Dim value As String: value = Trim(InputBox("移動先の行/列番号・セルを入力してください。", "移動先の指定", ActiveCell.address(False, False)))
    If Len(value) = 0 Then
        Exit Sub
    End If
    value = UCase(StrConv(value, vbNarrow))

    If Not value Like "*[!0-9]*" Then
        ' 行番号を入力した場合
        If Not isEnabledCellAddress("A" & value) Then
            Exit Sub
        End If
        Dim row As Long: row = CLng(value)
        Dim column As Long: column = ActiveCell.column
    ElseIf Not value Like "*[!A-Z]*" Then
        ' 列名を入力した場合
        If Not isEnabledCellAddress(value & "1") Then
            Exit Sub
        End If
        row = ActiveCell.row
        column = Range(value & "1").column
    ElseIf isEnabledCellAddress(value) Then
        ' A1形式でセルを指定した場合
        row = Range(value).row
        column = Range(value).column
    Else
        ' 有効な位置が指定されなかった場合
        Exit Sub
    End If

    With ActiveWindow
        With .VisibleRange
            Dim scrollRow As Integer: scrollRow = ActiveCell.row - .Cells(1, 1).row
            Dim scrollCol As Integer: scrollCol = ActiveCell.column - .Cells(1, 1).column
        End With

        Call Cells(row, column).Activate
        Call Application.Goto(ActiveCell, True)
        Call .SmallScroll(up:=scrollRow, toleft:=scrollCol)
    End With
    Application.ScreenUpdating = True
End Sub

' 文字列が有効なセルアドレスか判定する
Private Function isEnabledCellAddress(ByVal address As String) As Boolean
    isEnabledCellAddress = True
On Error GoTo RangeError
    Dim rng As Range: Set rng = Range(address)
    Exit Function
RangeError:
    isEnabledCellAddress = False
End Function