"Обратить выделение" - выделить все ячейки, кроме выделенных

Option Explicit
 
Dim alArrBegRows(), alArrEndRows(), alArrBegCols(), alArrEndCols()
Dim lMinRow As Long, lMaxRow As Long, lMinCol As Long, lMaxCol As Long
Sub Invert_Selection()
    Dim rArea As Range, rInvertRange As Range, rTmpRng As Range, rRng As Range
    Dim lr As Long, lc As Long, li As Long
    Dim lEndRow As Long, lEndCol As Long
    Dim bEqualRows As Boolean, bEqualCols As Boolean
 
    If TypeName(Selection) <> "Range" Then Exit Sub
    For Each rArea In Selection.Areas
        ReDim Preserve alArrBegRows(li), alArrEndRows(li), alArrBegCols(li), alArrEndCols(li)
        alArrBegRows(li) = rArea.Row: alArrEndRows(li) = rArea.Row + rArea.Rows.Count - 1
        alArrBegCols(li) = rArea.Column: alArrEndCols(li) = rArea.Column + rArea.Columns.Count - 1
        li = li + 1
    Next rArea
    lMinRow = alArrBegRows(0): lMaxRow = 0: lMinCol = alArrBegCols(0): lMaxCol = 0
    For li = 0 To UBound(alArrBegRows)
        If alArrBegRows(li) < lMinRow Then lMinRow = alArrBegRows(li)
        If alArrEndRows(li) > lMaxRow Then lMaxRow = alArrEndRows(li)
        If alArrBegCols(li) < lMinCol Then lMinCol = alArrBegCols(li)
        If alArrEndCols(li) > lMaxCol Then lMaxCol = alArrEndCols(li)
    Next li
    lEndRow = ActiveSheet.Rows.Count
    lEndCol = ActiveSheet.Columns.Count
    'максимальные пороги
    If lMaxRow <> lEndRow Then
        Set rInvertRange = Rows(lMaxRow + 1 & ":" & lEndRow)
    End If
    If lMaxCol <> lEndCol Then
        If Not rInvertRange Is Nothing Then
            Set rInvertRange = Union(rInvertRange, Range(Cells(1, lMaxCol + 1), Cells(1, lEndCol)).EntireColumn)
        Else
            Set rInvertRange = Range(Cells(1, lMaxCol + 1), Cells(1, lEndCol)).EntireColumn
        End If
    End If
    'минимальные пороги
    If lMinRow <> 1 Then
        If Not rInvertRange Is Nothing Then
            Set rInvertRange = Union(rInvertRange, Rows(1 & ":" & lMinRow - 1))
        Else
            Set rInvertRange = Rows(1 & ":" & lMinRow - 1)
        End If
    End If
    If lMinCol <> 1 Then
        If Not rInvertRange Is Nothing Then
            Set rInvertRange = Union(rInvertRange, Range(Cells(1, 1), Cells(1, lMinCol - 1)).EntireColumn)
        Else
            Set rInvertRange = Range(Cells(1, 1), Cells(1, lMinCol - 1)).EntireColumn
        End If
    End If
 
    For li = 0 To UBound(alArrBegRows)
        'Если выделен целый столбец/столбцы
        If alArrEndRows(li) = lEndRow And alArrBegRows(li) = 1 Then
            bEqualRows = 1
        Else
            bEqualRows = 0
        End If
        'Если выделена целая строка/строки
        If alArrEndCols(li) = lEndCol And alArrBegCols(li) = 1 Then
            bEqualCols = 1
        Else
            bEqualCols = 0
        End If
    Next li
    'Если выделены даже несвязанные строки/столбцы целиком
    If bEqualRows Then lMinRow = lMaxRow
    If bEqualCols Then lMinCol = lMaxCol
    'ячейки "внутри"
    For lr = lMinRow To lMaxRow
        For lc = lMinCol To lMaxCol
            If Intersect_Nums(lr, lc) = False Then
                If rRng Is Nothing Then
                    If lMinRow = lMaxRow Then
                        Set rRng = Cells(lr, lc).EntireColumn
                    Else
                        If lMinCol = lMaxCol Then
                            Set rRng = Cells(lr, lc).EntireRow
                        Else
                            Set rRng = Cells(lr, lc)
                        End If
                    End If
                Else
                    If lMinRow = lMaxRow Then
                        Set rRng = Union(rRng, Cells(lr, lc).EntireColumn)
                    Else
                        If lMinCol = lMaxCol Then
                            Set rRng = Union(rRng, Cells(lr, lc).EntireRow)
                        Else
                            Set rRng = Union(rRng, Cells(lr, lc))
                        End If
                    End If
                End If
            End If
        Next lc
    Next lr
    If Not rInvertRange Is Nothing Then
        If Not rRng Is Nothing Then
            Set rInvertRange = Union(rRng, rInvertRange)
        End If
    Else
        If Not rRng Is Nothing Then
            Set rInvertRange = rRng
        End If
    End If
 
    'Действия над инвертированным диапазоном
    If Not rInvertRange Is Nothing Then
        rInvertRange.Select
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Intersect_Nums
' Purpose   : Функция определения вхождения в диапазон
'---------------------------------------------------------------------------------------
Function Intersect_Nums(lr As Long, lc As Long) As Boolean
    Dim lCntR As Long, lCntC As Long, li As Long
    For li = LBound(alArrBegRows) To UBound(alArrBegRows)
        For lCntR = alArrBegRows(li) To alArrEndRows(li)
            For lCntC = alArrBegCols(li) To alArrEndCols(li)
                If lr = lCntR Then
                    If lc = lCntC Then Intersect_Nums = True: Exit Function
                End If
            Next lCntC
        Next lCntR
    Next li
End Function