Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1132to1136
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalten ohne Inhalt im sichtbaren Bereich ausblend

Spalten ohne Inhalt im sichtbaren Bereich ausblend
urs
Guten Abend
Über Filter werden die gesuchten Werte einer grossen Tabelle eingegrenzt.
Wie kann ich nun die Spalten automatisch ausblenden deren Inhalt in allen SICHTBAREN Zellen leer ist.
Wie ermittle ich das? Makro gesucht!
Vielen Dank für Eure Hilfe
Gruss Urs
AW: Spalten ohne Inhalt im sichtbaren Bereich ausblend
26.01.2010 20:14:05
Tino
Hallo,
kannst mal diesen Code testen, die Tabelle müsstest Du eventuell im Code noch anpassen.
Sub Test_Leer_Spalten_Aus()
Dim Bereich As Range, booIsLeer As Boolean
Dim tmpRng As Range, rngZellen As Range
Dim oSh As Worksheet

'Tabelle anpassen 
With Tabelle1
    Set Bereich = .UsedRange
    With Application.WorksheetFunction
        For Each Bereich In Bereich.Columns
            'Bereich.Cells(2, 1) zwei ist ohne Überschrift 
            Set rngZellen = Range(Bereich.Cells(2, 1), Bereich.Cells(Bereich.Rows.Count, 1))
            booIsLeer = .CountIf(rngZellen, "") = rngZellen.Cells.Count
                        
            If booIsLeer Then
                If Not tmpRng Is Nothing Then
                    Set tmpRng = Union(rngZellen, tmpRng)
                Else
                    Set tmpRng = rngZellen
                End If
            End If
        Next Bereich
    End With

    If Not tmpRng Is Nothing Then
        tmpRng.EntireColumn.Hidden = True
    End If
End With


End Sub
Gruß Tino
Anzeige
Es funzt nicht
27.01.2010 09:19:05
urs
Hallo Tino
Meine Tabelle ist ca 3000 Zeilen lang und umfasst 50 Spalten. Ich habe eine Überschriftszeile.
Wie muss ich dann in der nächsten Zeile die Zahlen setzen.
Set rngZellen = Range(Bereich.Cells(2, 1), Bereich.Cells(Bereich.Rows.Count, 1))
Ich hab noch zuwenig Ahnung zum Thema Bereich und UsedRange usw.
Gruss Urs
Ich sehs,aber Deine Filter filtern nichts!
27.01.2010 12:15:00
urs
Hallo Tino
ich habe Deine Datei gesehen und gestaunt wie alles prima läuft.
Ich habe nun in Spalte E ein Teil meines Problems eingebaut und:
1. mit enthält nicht den Buchstaben q gefiltert. -- Spalte E hat im noch sichtbaren Bereich keinen Eintrag.
2. Spalten ausblenden ausgelöst aber Spalte E verschwindet nicht. -- Sollte aber.
https://www.herber.de/bbs/user/67543.xls
Ich hoffe Du kannst mir weiterhelfen. Bis jetzt schon mal vielen Dank
Gruss urs
Anzeige
Schon besser aber es verschwinden zuviele Spalten
28.01.2010 12:54:43
urs
Hallo Tino
in Deinem Beispiel mit dem Filter "enthält nicht" q hat E keine Inhalte mehr und verschwindet. Gut.
Setze ich aber gar keinen Filter, so verschwindet E auch!! Das sollte nicht sein.
Ist es möglich, dass in Deinem Skript Spalten ausgeblendet werd, sobald nur eine Zelle im sichtbaren Bereich leer ist? Fals ja, es sollte genau umgekehrt sein - sobald im sichtbarten Bereich eine Zelle nicht leer ist sollte sie nicht ausgeblendet werden.
Was meinst Du, kannst du mir weiterhelfen? Schon mal herzlichen Dank.
Gruss urs
Anzeige
Danke! - That's the way I like it :-)
28.01.2010 14:49:10
urs
Hallo Tino
Ich habe die Makro Textänderungen von Dir angesehen und konnte nun daraus schon wieder etwas lernen. Vielen Dank. Habe aber auch festgestellt, das meine eigenen Makrokünste höchstens für den Hinterhof taugen.
Grüsse aus der verschneiten Schweiz sendet Urs
Zusatzfrage zum Thema
28.01.2010 15:57:46
urs
Hallo Tino
bei Deiner Tabelle startest Du das Macro über die Taste Spalte ausblenden.
Wie muss ich das Lösen, wenn ich keine Taste gebrauchen kann, weil ich das Macro in der PERSNL-Arbeitsmappe in einem Modul versorgt haben möchte.
Was muss Syntax mässig geändert werden?
Nach der "With"-Zeile in Deiner bisherigen Syntax habe ich noch folgende 2 Zeilen zugefügt.
  • ' Der folgende Befehl reduziert im sichtbaren Bereich die Spaltenbreite auf das nötigste
    ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Columns.AutoFit

  • Siehst Du einen Weg? Gruss Urs
    Anzeige
    AW: Zusatzfrage zum Thema
    28.01.2010 16:32:25
    Tino
    Hallo,
    vielleicht würde ich es so machen,
    dass Makro kannst Du nach erneuten öffnen von Excel mit Strg+Alt+b starten.
    kommt als Code in DieseArbeitsmappe
    Option Explicit 
     
    Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Application.OnKey "^%b" 
    End Sub 
     
    Private Sub Workbook_Open() 
    Application.OnKey "^%b", "Test_Leer_Spalten_Aus" 
    End Sub 
    
    kommt als Code in Modul1
    Option Explicit 
     
    Function ZaehleSichtbareLeere(ByVal Bereich As Range, MaxOG As Long) As Boolean 
    Dim LCounter As Long 
    Dim LAnzahlZellen As Long 
        On Error Resume Next 
        Set Bereich = Bereich.SpecialCells(xlCellTypeVisible) 
        On Error GoTo 0 
         
        If Bereich Is Nothing Then Exit Function 
        If Bereich.Cells.Count = MaxOG Then Exit Function 
        LAnzahlZellen = Bereich.Cells.Count 
        With Application.WorksheetFunction 
            For Each Bereich In Bereich.Areas 
                LCounter = LCounter + .CountIf(Bereich, "") 
            Next Bereich 
        End With 
         
        ZaehleSichtbareLeere = LCounter = (LAnzahlZellen - MaxOG) 
     
    End Function 
     
    Sub Test_Leer_Spalten_Aus() 
    Dim Bereich As Range, booIsLeer As Boolean 
    Dim tmpRng As Range 
    Dim oSh As Worksheet 
     
    Static booVisible As Boolean 
     
    With ActiveWorkbook.ActiveSheet 
        If Not booVisible Then 
                Set Bereich = .UsedRange 
                    For Each Bereich In Bereich.Columns 
                        If ZaehleSichtbareLeere(Bereich, 1) Then 
                            If Not tmpRng Is Nothing Then 
                                Set tmpRng = Union(Bereich, tmpRng) 
                            Else 
                                Set tmpRng = Bereich 
                            End If 
                        End If 
                    Next Bereich 
                 
                If Not tmpRng Is Nothing Then 
                    tmpRng.EntireColumn.Hidden = True 
                    booVisible = True 
                End If 
             
        Else 
                .UsedRange.EntireColumn.Hidden = False 
                booVisible = False 
        End If 
    End With 
    End Sub 
     
    
    Gruß Tino
    Anzeige
    Danke, teste übers Wochenende
    28.01.2010 16:57:01
    urs
    Hallo Tino
    ich möchte dir für Deine Hilfe danken. Ich komme erst übers Wochende zum Testen. Gruss urs

    309 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige