Selection

[chris-ka]

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.

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

[Nora Fernandez]

Vielen Dank für eure Mühe!