'選択解除するマクロと選択範囲以外を選択するマクロ

Option Explicit

'指定範囲を選択解除するマクロ

Sub UnselectSelectedRange()
    Const StatusbarHeight = 30
    Dim r As Range

    If TypeName(Selection) <> "Range" Then Exit Sub
    If Selection.Cells.Count = 1 Then Exit Sub

    On Error Resume Next
    Set r = Application.InputBox( _
        prompt:="解除するセル範囲を選択してください。", _
        Title:="選択解除", Left:=0, _
        Top:=Application.UsableHeight - Application.Height + StatusbarHeight, _
        Type:=8)
    On Error GoTo 0
    If r Is Nothing Then Exit Sub

    Set r = UnunionRange(Selection, r)

    'セル範囲を選択
    If r Is Nothing Then
        MsgBox "選択解除後に残るセルがありません。", vbExclamation, "選択解除"
    Else
        r.Select
    End If
End Sub


'現在の選択範囲以外を選択するマクロ

Sub ReverseRangeSelect()
    Const StatusbarHeight = 30
    Dim r As Range

    If TypeName(Selection) <> "Range" Then Exit Sub

    Do While True
        On Error Resume Next
        Set r = Application.InputBox( _
            prompt:="セル範囲を選択してください。", _
            Title:="現在の選択範囲以外の選択", Left:=0, _
            Top:=Application.UsableHeight - Application.Height + StatusbarHeight, _
            Type:=8)
        On Error GoTo 0
        If r Is Nothing Then Exit Sub
        If (r.Worksheet.Name <> ActiveSheet.Name) Or _
                (r.Worksheet.Parent.Name <> ActiveWorkbook.Name) Then
            MsgBox "アクティブシート以外の範囲に対しては実行できません。", _
                vbExclamation, "現在の選択範囲以外の選択"
        Else
            Exit Do
        End If
    Loop

    Set r = UnunionRange(r, Selection)

    'セル範囲を選択
    If Not (r Is Nothing) Then r.Select

End Sub


'セル範囲からセル範囲を取り除く関数

Function UnunionRange(oRange1 As Range, oRange2 As Range) As Range
    Dim oApplication As Object
    Dim oSheet1 As Worksheet
    Dim iRowMax As Long, iColumnMax As Long
    Dim iRowsCount As Long, iColumnsCount As Long
    Dim iTop As Long, iBottom As Long
    Dim iLeft As Long, iRight As Long
    Dim oRange_Out(1 To 4) As Range
    Dim oRange_Reverse As Range
    Dim oRange_Result As Range
    Dim r As Range
    Dim i As Integer

    Set UnunionRange = Nothing
    Set oRange_Result = Nothing
    Set oApplication = Application
    Set oSheet1 = oRange1.Worksheet
    If oSheet1.Name <> oRange2.Worksheet.Name Or _
        oSheet1.Parent.Name <> oRange2.Worksheet.Parent.Name Then
        Set UnunionRange = oRange1
        Exit Function
    End If

    iRowMax = oSheet1.Rows.Count
    iColumnMax = oSheet1.Columns.Count

    For Each r In oRange2.Areas
        iRowsCount = r.Rows.Count
        iColumnsCount = r.Columns.Count
        iTop = r.Row
        iBottom = iTop + iRowsCount - 1
        iLeft = r.Column
        iRight = iLeft + iColumnsCount - 1

        For i = 1 To 4
            Set oRange_Out(i) = Nothing
        Next
        If iTop > 1 Then
            Set oRange_Out(1) = oSheet1.Rows(1).Resize(iTop - 1)
        End If
        If iBottom < iRowMax Then
            Set oRange_Out(4) = oSheet1.Rows(iTop + iRowsCount) _
                .Resize(iRowMax - iBottom)
        End If
        If iLeft > 1 Then
            Set oRange_Out(2) = oSheet1.Cells(iTop, 1) _
                .Resize(iRowsCount, iLeft - 1)
        End If
        If iRight < iColumnMax Then
            Set oRange_Out(3) = oSheet1.Cells(iTop, iLeft + iColumnsCount) _
                .Resize(iRowsCount, iColumnMax - iRight)
        End If

        Set oRange_Reverse = Nothing
        For i = 1 To 4
            If Not (oRange_Out(i) Is Nothing) Then
                If oRange_Reverse Is Nothing Then
                    Set oRange_Reverse = oRange_Out(i)
                Else
                    Set oRange_Reverse = oApplication.Union( _
                        oRange_Reverse, oRange_Out(i))
                End If
            End If
        Next


        If oRange_Reverse Is Nothing Then Exit Function
        Set oRange_Reverse = oApplication.Intersect(oRange_Reverse, oRange1)
        If oRange_Reverse Is Nothing Then Exit Function
        If oRange_Result Is Nothing Then
            Set oRange_Result = oRange_Reverse
        Else
            Set oRange_Result = oApplication.Intersect( _
                oRange_Result, oRange_Reverse)
        End If
    Next
    Set UnunionRange = oRange_Result
End Function