Attribute VB_Name = "Modul1"
Option Base 1


'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr
'Code von unnötigem Ballast befreit
'und Variablennamen nach DIN :-)
'durch: Frank Arendt-Theilen

Sub AuswahlInvertieren()
Dim arrAreas() As String
Dim lngI As Long
Dim rngBereich As Range
  ReDim arrAreas(Selection.Areas.Count)
  For lngI = 1 To UBound(arrAreas)
    arrAreas(lngI) = Selection.Areas(lngI).Address
  Next
  On Error GoTo err_select
  Set rngBereich = Range(invers_selection(Range(arrAreas(1))))
  For lngI = 2 To UBound(arrAreas)
    Set rngBereich = Intersect(rngBereich, _
    Range(invers_selection(Range(arrAreas(lngI)))))
  Next
  rngBereich.Select
Exit Sub
err_select:
ActiveCell.Select
End Sub

Private Function invers_selection(act_select As Range) As String
'On Error Resume Next
Dim part1 As Range
Dim part2 As Range
Dim part3 As Range
Dim part4 As Range
Dim p As Integer
   p = 0
   If act_select.Row > 1 Then
      Set part1 = Rows("1:" & act_select.Row - 1)
      p = 1
   End If
   If act_select.Row + act_select.Rows.Count - 1 < 65536 Then
   Set part2 = Rows(act_select.Row + act_select.Rows.Count & ":65536")
      p = p + 2
   End If
   If act_select.Column > 1 Then
      Set part3 = Range(Columns(1), Columns(act_select.Column - 1))
      p = p + 4
   End If
   If act_select.Column + act_select.Columns.Count - 1 < 256 Then
      Set part4 = Range(Columns(act_select.Column + _
         act_select.Columns.Count), Columns(256))
      p = p + 8
   End If
   invers_selection = ""
   Do While p > 0
   Select Case p
      Case 1, 3, 5, 7, 9, 11, 13, 15:
              If invers_selection = "" Then
                 invers_selection = part1.Address
              Else
     invers_selection = Union(Range(invers_selection), part1).Address
              End If
              p = p - 1
      Case 2, 6, 10, 14:
              If invers_selection = "" Then
                 invers_selection = part2.Address
              Else
      invers_selection = Union(Range(invers_selection), part2).Address
              End If
              p = p - 2
      Case 4, 12:
              If invers_selection = "" Then
                 invers_selection = part3.Address
              Else
      invers_selection = Union(Range(invers_selection), part3).Address
              End If
              p = p - 4
      Case 8:
              If invers_selection = "" Then
                 invers_selection = part4.Address
              Else
      invers_selection = Union(Range(invers_selection), part4).Address
              End If
              p = p - 8
   End Select
   Loop
End Function