AW: Aus einer UF aufrufen
29.04.2012 18:29:46
Tino
Hallo,
habe Deine Datei nicht geladen, kannst es aber mal so versuchen.
Wirkt auf die aktive Tabelle.
Selection ist automatisch auch die aktive Tabelle,
weil eine nicht aktive Tabelle keine Selection oder aktive Zelle besitzt.
kommt als Code in UserForm1
Option Explicit
Private Sub CommandButton1_Click()
Dim rngX As Range, rngC As Range, rngE As Range
For Each rngX In Selection.EntireRow.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
End If
Next rngX
Set rngE = Intersect(rngE, Range(Rows(3), Rows(154)))
If Not rngE Is Nothing Then
rngE.EntireRow.Hidden = True
End If
End Sub
kommt als Code in Modul1
Option Explicit
'********************************************************
'Code ist von Erich aus Kamp-Lintfort *
'********************************************************
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 < Rows.Count Then
If rngT Is Nothing Then
Set rngT = Range(Rows(zb + 1), Rows(Rows.Count))
Else
Set rngT = Union(rngT, Range(Rows(zb + 1), Rows(Rows.Count)))
End If
End If
If sv > 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 < Columns.Count Then
If rngT Is Nothing Then
Set rngT = Range(Cells(zv, sb + 1), Cells(zb, Columns.Count))
Else
Set rngT = Union(rngT, Range(Cells(zv, sb + 1), Cells(zb, Columns.Count)))
End If
End If
Set ComplementRect = rngT
End Function
Gruß Tino