Selektion umkehren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi
das könnte über ein kleines Makro funktionieren, daß du dann entsprechen einer Taste zuweist.
der erste Fall (ganze Spalten) ist relativ einfach, da man hier mit Ausblenden arbeiten kann.

Sub Selektion_umkehren_Spalten()
Selection.EntireColumn.Hidden = True
Cells.SpecialCells(xlCellTypeVisible).Select
Cells.EntireColumn.Hidden = False
End Sub

im zweiten Fall wirds schwieriger, daß ist mir keine bessere Lösung eingefallen, als jede Zelle einzeln zu prüfen.
damit das Makro nicht solange läuft, wird die Funktion auf den genutzten Bereich eingeschränkt.

Sub Selektion_umkehren_Zellen()
Dim Zelle As Range
Dim SelAlt As Range
Dim SelNeu As Range
Application.StatusBar = "Makro läuft"
Set SelAlt = Selection
For Each Zelle In ActiveSheet.UsedRange
If Intersect(Zelle, SelAlt) Is Nothing Then
If SelNeu Is Nothing Then
Set SelNeu = Zelle
Else
Set SelNeu = Union(SelNeu, Zelle)
End If
End If
Next
If Not SelNeu Is Nothing Then SelNeu.Select
Application.StatusBar = False
End Sub

Gruß, Daniel

Option Explicit Sub Invertiere_Selection() Dim rBereich As Range, tempBereich As Range With Application .ScreenUpdating = False 'Spalten *********************************************** For Each tempBereich In Selection.Areas tempBereich.EntireColumn.Hidden = True Next tempBereich On Error Resume Next Set rBereich = Cells.SpecialCells(xlCellTypeVisible) On Error GoTo 0 Cells.EntireColumn.Hidden = False 'Zeilen ************************************************* For Each tempBereich In Selection.Areas tempBereich.EntireRow.Hidden = True Next tempBereich On Error Resume Next If rBereich Is Nothing Then Set rBereich = Cells.SpecialCells(xlCellTypeVisible) Else Set rBereich = Union(rBereich, Cells.SpecialCells(xlCellTypeVisible)) End If On Error GoTo 0 Cells.EntireRow.Hidden = False If Not rBereich Is Nothing Then rBereich.Select End If .ScreenUpdating = True End With End Sub

Sub Selektion_invertieren() Dim selAlt As Range, selNeu As Range Dim Zelle As Range Dim Ze1 As Long, Ze2 As Long, Sp1 As Long, Sp2 As Long Set selAlt = Selection Sp1 = Columns.Count Ze1 = Rows.Count With WorksheetFunction For Each Zelle In selAlt.Areas Sp1 = .Min(Sp1, Zelle.Column) Sp2 = .Max(Sp2, Zelle.Column + Zelle.Columns.Count - 1) Ze1 = .Min(Ze1, Zelle.Row) Ze2 = .Max(Ze2, Zelle.Row + Zelle.Rows.Count - 1) Next End With If Sp1 > 1 Then Set selNeu = Verbinden(selNeu, Range(Columns(1), Columns(Sp1 - 1))) If Sp2 1 Then Set selNeu = Verbinden(selNeu, Range(Rows(1), Rows(Ze1 - 1))) If Ze2

Sub Invertiere_Selection() Dim TSh As Worksheet, akSh As Worksheet Dim rSel As Range, L As Long With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False Set akSh = ActiveSheet Set rSel = Selection Set TSh = Sheets.Add With TSh .Range(rSel.Address).Value = 1 Set rSel = .Cells.SpecialCells(xlCellTypeBlanks) L = .UsedRange.Rows(.UsedRange.Cells.Rows.Count).Row If L < TSh.Rows.Count Then Set rSel = Union(rSel, .Range(.Rows(L + 1), .Rows(.Rows.Count))) End If L = .UsedRange.Columns(.UsedRange.Cells.Columns.Count).Column If L < TSh.Columns.Count Then Set rSel = Union(rSel, .Range(.Columns(L + 1), .Columns(.Columns.Count))) End If End With akSh.Select akSh.Range(rSel.Address).Select TSh.Delete .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End Sub

Option Explicit Sub SelectComplement() Dim rngX As Range, rngC As Range, rngE As Range For Each rngX In Selection.Areas Set rngC = ComplementRect(rngX) If Not rngC Is Nothing Then If rngE Is Nothing Then Set rngE = rngC Else Set rngE = Intersect(rngE, rngC) End If Next rngX If rngE Is Nothing Then MsgBox "Nix zu selektieren" Else rngE.Select End Sub Function ComplementRect(rngA As Range) As Range Dim zv As Long, zb As Long, sv As Long, sb As Long, rngT As Range zv = rngA.Row zb = zv + rngA.Rows.Count - 1 sv = rngA.Column sb = sv + rngA.Columns.Count - 1 If zv > 1 Then Set rngT = Range(Rows(1), Rows(zv - 1)) If zb 1 Then If rngT Is Nothing Then Set rngT = Range(Cells(zv, 1), Cells(zb, sv - 1)) Else Set rngT = Union(rngT, Range(Cells(zv, 1), Cells(zb, sv - 1))) End If End If If sb

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread