alle ausgeblendeten Zeilen und Spalten auflisten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: alle ausgeblendeten Zeilen und Spalten auflisten
von: stormlamp
Geschrieben am: 17.06.2015 18:39:13

Hallo Zusammen,
ich bearbeite eine Mappe mit mehreren Tausend Zeilen und Spalten. Darin sind Zeilen und Spalten ausgeblendet aus verschiedenen Gründen. Ich möchte diese jedoch nicht einblenden, damit diese Zeilen und Spalten weiterhin unberücksichtigt bleiben.
Ich möchte jedoch wissen, welche Zeilen und Spalten genau ausgeblendet sind, um mir nur gezielt den Inhalt einmal anschauen zu können.
Daher suche ich ein Makro, das mir in einem separaten Tabellenblatt alle ausgeblendeten Zeilen und Spalten auflistet.
Kann mir dazu bitte jemand helfen.
Gruß
stormlamp

Bild

Betrifft: AW: alle ausgeblendeten Zeilen und Spalten auflisten
von: Sepp
Geschrieben am: 17.06.2015 19:38:39
Hallo ?,
anbei eine mögliche Lösung.
Der erste Code gehört in das Modul "Diese Arbeitsmappe", der zweite in ein allgemeines Modul!
Der Code erstellt eine neue Tabelle, auf der die ausgeblendeten Zeilen bzw. Spalten des aktiven Tabellenblattes ausgegeben werden. Per Doppelklick auf eine Zeilen oder Spaltennummer kannst du zur jeweiligen Zeile/Spalte springen.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  If Sh.Name = "Hidden Cells" Then
    If SheetExist(Sh.Cells(1, 1).Text) Then
      If IsNumeric(Target) Then
        If Target.Column = 1 Then
          Cancel = True
          Application.Goto Sheets(Sh.Cells(1, 1).Text).Rows(Target), True
        ElseIf Target.Column = 3 Then
          Cancel = True
          Application.Goto Sheets(Sh.Cells(1, 1).Text).Columns(Target), True
        End If
      End If
    End If
  End If
End Sub


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub hiddenRowsAndColumns()
  Dim rng As Range
  Dim vntRows() As Variant, vntCols() As Variant
  Dim lngLast As Long, lngR As Long, lngC As Long
  Dim objSH As Worksheet
  Dim strName As String
  
  On Error GoTo ErrExit
  
  With ActiveSheet
    If .Name <> "Hidden Cells" Then
      strName = .Name
      lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
      For Each rng In .Range(.Cells(1, 1), .Cells(lngLast, 1))
        If .Rows(rng.Row).Hidden Then
          Redim Preserve vntRows(lngR)
          vntRows(lngR) = rng.Row
          lngR = lngR + 1
        End If
      Next
      
      lngLast = Application.Max(2, .Cells(1, .Columns.Count).End(xlToLeft).Column)
      For Each rng In .Range(.Cells(1, 1), .Cells(1, lngLast))
        If .Columns(rng.Column).Hidden Then
          Redim Preserve vntCols(lngC)
          vntCols(lngC) = rng.Column
          lngC = lngC + 1
        End If
      Next
    End If
  End With
  
  If lngR > 0 Or lngC > 0 Then
    If SheetExist("Hidden Cells") Then
      Set objSH = Sheets("Hidden Cells")
      objSH.Cells.Clear
    Else
      Set objSH = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSH.Name = "Hidden Cells"
    End If
    With objSH
      .Cells(1, 1) = strName
      If lngR > 0 Then
        .Cells(3, 1) = "Hidden Rows"
        .Cells(4, 1).Resize(lngR, 1) = Application.Transpose(vntRows)
      End If
      
      If lngC > 0 Then
        .Cells(3, 3) = "Hidden Columns"
        .Cells(4, 3).Resize(lngC, 1) = Application.Transpose(vntCols)
      End If
      .Columns.AutoFit
      .Activate
    End With
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'hiddenRowsAndColumns'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - hiddenRowsAndColumns"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  Set objSH = Nothing
End Sub


Public Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp


Bild

Betrifft: AW: alle ausgeblendeten Zeilen und Spalten auflisten
von: stormlamp
Geschrieben am: 17.06.2015 19:52:10
Hallo Sepp,
vielen Dank für das Makro, leider erzeugt es in meinem Excel 2010 jedoch kein neues Tabellenblatt mit Inhalten.
Viele Grüße
Hans

Bild

Betrifft: AW: alle ausgeblendeten Zeilen und Spalten auflisten
von: Sepp
Geschrieben am: 17.06.2015 19:57:22
Hallo Hans,
dann bist du beim Start des Makros auf einem Tabellenblatt OHNE ausgeblendete Zeilen und/oder Spalten!
Hier der Code mit check auf ausgeblendete Zellen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub hiddenRowsAndColumns()
  Dim rng As Range
  Dim vntRows() As Variant, vntCols() As Variant
  Dim lngLast As Long, lngR As Long, lngC As Long
  Dim objSH As Worksheet
  Dim strName As String
  
  On Error GoTo ErrExit
  
  With ActiveSheet
    If .Name <> "Hidden Cells" Then
      If .UsedRange.Count > .UsedRange.SpecialCells(xlCellTypeVisible).Count And .UsedRange.Count > 1 Then
        strName = .Name
        lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
        For Each rng In .Range(.Cells(1, 1), .Cells(lngLast, 1))
          If .Rows(rng.Row).Hidden Then
            Redim Preserve vntRows(lngR)
            vntRows(lngR) = rng.Row
            lngR = lngR + 1
          End If
        Next
        
        lngLast = Application.Max(2, .Cells(1, .Columns.Count).End(xlToLeft).Column)
        For Each rng In .Range(.Cells(1, 1), .Cells(1, lngLast))
          If .Columns(rng.Column).Hidden Then
            Redim Preserve vntCols(lngC)
            vntCols(lngC) = rng.Column
            lngC = lngC + 1
          End If
        Next
      Else
        MsgBox "Keine versteckten Spalten oder Zeilen in diesem Tabellenblatt!", vbInformation
        Exit Sub
      End If
    End If
  End With
  
  If lngR > 0 Or lngC > 0 Then
    If SheetExist("Hidden Cells") Then
      Set objSH = Sheets("Hidden Cells")
    Else
      Set objSH = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSH.Name = "Hidden Cells"
    End If
    With objSH
      .Cells.Clear
      .Cells(1, 1) = strName
      If lngR > 0 Then
        .Cells(3, 1) = "Hidden Rows"
        .Cells(4, 1).Resize(lngR, 1) = Application.Transpose(vntRows)
      End If
      
      If lngC > 0 Then
        .Cells(3, 3) = "Hidden Columns"
        .Cells(4, 3).Resize(lngC, 1) = Application.Transpose(vntCols)
      End If
      .Columns.AutoFit
      .Activate
    End With
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'hiddenRowsAndColumns'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - hiddenRowsAndColumns"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  Set objSH = Nothing
End Sub


Public Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp


Bild

Betrifft: AW: alle ausgeblendeten Zeilen und Spalten auflisten
von: stormlamp
Geschrieben am: 17.06.2015 20:23:44
Hallo Sepp,
bei mir funktioniert es leider trotzdem nicht:
Neue leere Excelmappe erstellt
Makros in "Arbeitsmappe" und "Modul" kopiert
Spalten H bis K ausgeblendet
Zeilen 25 bis 20 ausgeblendet
Makro gestartet
Ergebnis: keinerlei Reaktion, keine neue Tabelle, nichts passiert.
Mache ich etwas falsch?
Viele Grüße
Hans

Bild

Betrifft: Daten in den Zellen?
von: Sepp
Geschrieben am: 17.06.2015 20:27:36
Hallo Hans,
es müssen natürlich schon Daten in den Zellen stehen! Die erste Spalte und die erste Zeile müssen gefüllt sein, so wie halt eine Tabelle lt. Definition aussieht!

Gruß Sepp


Bild

Betrifft: AW: Daten in den Zellen?
von: stormlamp
Geschrieben am: 17.06.2015 20:46:16
Hallo Sepp,
vielen Dank, das war der Haken. Nun läuft es super.
Wäre es noch eine größere Modifikation, wenn bei den Spalten statt einer Ziffer die Spaltenbuchstaben ausgegeben würden?
Viele Grüße
Hans

Bild

Betrifft: AW: Daten in den Zellen?
von: Sepp
Geschrieben am: 17.06.2015 21:12:42
Hallo Hans,
klar, das geht auch.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
  If Sh.Name = "Hidden Cells" Then
    If SheetExist(Sh.Cells(1, 1).Text) Then
      If Target <> "" Then
        If Target.Column = 1 Then
          Cancel = True
          Application.Goto Sheets(Sh.Cells(1, 1).Text).Rows(Target), True
        ElseIf Target.Column = 3 Then
          Cancel = True
          Application.Goto Sheets(Sh.Cells(1, 1).Text).Columns(Target & ":" & Target), True
        End If
      End If
    End If
  End If
End Sub


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub hiddenRowsAndColumns()
  Dim rng As Range
  Dim vntRows() As Variant, vntCols() As Variant
  Dim lngLast As Long, lngR As Long, lngC As Long
  Dim objSH As Worksheet
  Dim strName As String
  
  On Error GoTo ErrExit
  
  With ActiveSheet
    If .Name <> "Hidden Cells" Then
      If .UsedRange.Count > .UsedRange.SpecialCells(xlCellTypeVisible).Count And .UsedRange.Count > 1 Then
        strName = .Name
        lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
        For Each rng In .Range(.Cells(1, 1), .Cells(lngLast, 1))
          If .Rows(rng.Row).Hidden Then
            Redim Preserve vntRows(lngR)
            vntRows(lngR) = rng.Row
            lngR = lngR + 1
          End If
        Next
        
        lngLast = Application.Max(2, .Cells(1, .Columns.Count).End(xlToLeft).Column)
        For Each rng In .Range(.Cells(1, 1), .Cells(1, lngLast))
          If .Columns(rng.Column).Hidden Then
            Redim Preserve vntCols(lngC)
            vntCols(lngC) = Split(rng.EntireColumn.Address(0, 0), ":")(0)
            lngC = lngC + 1
          End If
        Next
      Else
        MsgBox "Keine versteckten Spalten oder Zeilen in diesem Tabellenblatt!", vbInformation
        Exit Sub
      End If
    End If
  End With
  
  If lngR > 0 Or lngC > 0 Then
    If SheetExist("Hidden Cells") Then
      Set objSH = Sheets("Hidden Cells")
    Else
      Set objSH = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSH.Name = "Hidden Cells"
    End If
    With objSH
      .Cells.Clear
      .Cells(1, 1) = strName
      If lngR > 0 Then
        .Cells(3, 1) = "Hidden Rows"
        .Cells(4, 1).Resize(lngR, 1) = Application.Transpose(vntRows)
      End If
      
      If lngC > 0 Then
        .Cells(3, 3) = "Hidden Columns"
        .Cells(4, 3).Resize(lngC, 1) = Application.Transpose(vntCols)
      End If
      .Columns.AutoFit
      .Activate
    End With
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'hiddenRowsAndColumns'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - hiddenRowsAndColumns"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  Set objSH = Nothing
End Sub


Public Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp


Bild

Betrifft: AW: Daten in den Zellen?
von: stormlamp
Geschrieben am: 17.06.2015 21:58:27
Hallo Sepp,
ganz herzlichen Dank für diese perfekte Lösung. Du hast mir sehr geholfen!
Mit freundlichen Grüßen
Hans

 Bild

Beiträge aus den Excel-Beispielen zum Thema "alle ausgeblendeten Zeilen und Spalten auflisten"