AW: Selektion umkehren
K.Rola
Hallo,
ist komplizierter als so denkt.
Option Base 1
Sub machs()
Dim rngSelection As Range
Set rngSelection = Range(inv_Range(Selection))
rngSelection.Select
End Sub
Private Function inv_Range(rngS As Range)
On Error Resume Next
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim c As Long, rc As Long, cc As Integer
rc = ActiveSheet.Rows.Count
cc = ActiveSheet.Columns.Count
c = 0
If rngS.Row > 1 Then
Set rng1 = Rows("1:" & rngS.Row - 1)
c = 1
End If
If rngS.Row + rngS.Rows.Count - 1 < rc Then
Set rng2 = Rows(rngS.Row + rngS.Rows.Count & ":" & rc)
c = c + 2
End If
If rngS.Column > 1 Then
Set rng3 = Range(Columns(1), Columns(rngS.Column - 1))
c = c + 4
End If
If rngS.Column + rngS.Columns.Count - 1 < cc Then
Set rng4 = Range(Columns(rngS.Column + _
rngS.Columns.Count), Columns(cc))
c = c + 8
End If
inv_Range = ""
Do While c > 0
Select Case c
Case 1, 3, 5, 7, 9, 11, 13, 15:
If inv_Range = "" Then
inv_Range = rng1.Address
Else
inv_Range = Union(Range(inv_Range), rng1).Address
End If
c = c - 1
Case 2, 6, 10, 14:
If inv_Range = "" Then
inv_Range = rng2.Address
Else
inv_Range = Union(Range(inv_Range), rng2).Address
End If
c = c - 2
Case 4, 12:
If inv_Range = "" Then
inv_Range = rng3.Address
Else
inv_Range = Union(Range(inv_Range), rng3).Address
End If
c = c - 4
Case 8:
If inv_Range = "" Then
inv_Range = rng4.Address
Else
inv_Range = Union(Range(inv_Range), rng4).Address
End If
c = c - 8
End Select
Loop
End Function
Gruß K.Rola