23.12.2015, 08:04
Hi,
^^
Hier noch eine Demo..
Ausgeblendete Zeilen, Spalten, Mergecells, Mehrfachmarkierungen (mit gedr. Strg. Taste) werden berücksichtigt)
und die Zeilen im Benutzen Bereich werden ausgegeben.
^^
Hier noch eine Demo..
Ausgeblendete Zeilen, Spalten, Mergecells, Mehrfachmarkierungen (mit gedr. Strg. Taste) werden berücksichtigt)
und die Zeilen im Benutzen Bereich werden ausgegeben.
Code:
Option Explicit
' by Kaiser 2015
Sub sichtbarer_Bereich_Zeilen_im_benutzten_Bereich()
Dim rngC As Range, lng_fR As Long, lng_lR As Long, rng_a As Range, lng_cR As Long, lng_countR As Long
lng_fR = Cells.Rows.Count
'Falls mal keine Zelle markiert ist z.B eine Grafik
If TypeOf Selection Is Range Then
'merkt sich den alten Zustand der Tabelle
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.CustomViews.Add ViewName:="alt", PrintSettings:=True, RowColSettings:=True
Application.DisplayAlerts = True
Cells.EntireColumn.AutoFit
'wenn jemand mit Strg markiert...(Mehrfachmarkierung)
For Each rng_a In Selection.Areas 'rng_a = Selectierte Bereiche
lng_fR = WorksheetFunction.Min(lng_fR, rng_a.Row) 'fR =first_Row
lng_lR = WorksheetFunction.Max(lng_lR, rng_a.Rows.Count + rng_a.Row - 1) 'lR =last_Row
Next
'falls mal keine Zeilen im benutzen Bereich markiert ist 'oder statt Rows(lng_fR & ":" & lng_lR) -> Selection verwenden, wäre Zelle im im benutzen Bereich
If Not Intersect(ActiveSheet.UsedRange, Rows(lng_fR & ":" & lng_lR)) Is Nothing Then
'falls jemand ganze Spalten markiert oder eben einfach zu viel -> nur den benutzen Bereich nehmen
For Each rngC In Intersect(ActiveSheet.UsedRange, Rows(lng_fR & ":" & lng_lR)).SpecialCells(xlCellTypeVisible).Rows
MsgBox rngC.Row
lng_countR = lng_countR + 1
' was mit dieser Zeile gemacht werden sollte (deine Prüfungen)
Next
MsgBox "Anzahl der markierten Zeilen:=" & lng_countR
Else
MsgBox " Es sind keine Zeilen im benutzten Bereich markiert, Programm wird beendet" 'Zellen, bzw. Zeilen im Text anpassen
End If
Else
MsgBox " Es sind keine Zellen markiert, Programm wird beendet"
'Exit Sub ->falls der Code noch weitergeht
End If
'stellt wieder die ursprüngliche Ansicht der Tabelle her
ActiveWorkbook.CustomViews("alt").Show
Application.ScreenUpdating = True
End Sub