Grüezi keepITcool

keepITcool schrieb am 23.07.2004

does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

I just found this thread here.
Maybe the following functions could do the 'trick'?


Sub Test()
InversRange(Selection).Select
End Sub

Public Function InversRange(Bereich As Range) As Range
Dim lngI As Long
Dim rngBereich As Range
On Error GoTo err_Select
Set rngBereich = Invers_Area(Bereich.Areas(1))
For lngI = 2 To Bereich.Areas.Count
Set rngBereich = Intersect(rngBereich, _
Invers_Area(Bereich.Areas(lngI)))
Next
Set InversRange = rngBereich
Exit Function
err_Select:
'in dieser Anwendung kann man hier ruhig nothing setzen,
'Activecell war nur benutzt, um eine Fehlermeldung zu vermeiden!
Set InversRange = Nothing
End Function

Private Function Invers_Area(act_select As Range) As Range
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
Set Invers_Area = Nothing
Do While p 0
Select Case p
'so gefällt es mir inzwischen besser - einfach auf den Kopf gestellt!
Case Is = 8:
If Invers_Area Is Nothing Then
Set Invers_Area = part4
Else
Set Invers_Area = Union(Invers_Area, part4)
End If
p = p - 8
Case Is = 4:
If Invers_Area Is Nothing Then
Set Invers_Area = part3
Else
Set Invers_Area = Union(Invers_Area, part3)
End If
p = p - 4
Case Is = 2:
If Invers_Area Is Nothing Then
Set Invers_Area = part2
Else
Set Invers_Area = Union(Invers_Area, part2)
End If
p = p - 2
Case 1:
If Invers_Area Is Nothing Then
Set Invers_Area = part1
Else
Set Invers_Area = Union(Invers_Area, part1)
End If
p = p - 1
End Select

Loop
End Function

--
Regards

Thomas Ramel
- MVP for Microsoft-Excel -

[Win XP Pro SP-1 / xl2000 SP-3]