Spalten ausblenden nach Bedingung; VBA

Question

Hallo liebe Community,

ich bin im Rahmen der VBA-Programmierung bin ich leider vollkommender Neuling.

Ich habe in einer Tabelle von G7 bis NG7 verschiedene Werte stehen mittels Makro will ich alle Spalten ausblenden, die nicht in zeile 7 einen bestimmten Wert haben, welcher in A7 vorgegeben wird dazu setze ich folgendes Makro ein den ich mir schon durch recherchieren zusammengebastelt habe:

Sub Spalten()
   Dim iCol As Integer
   ' alle Spalten einblenden
   ActiveSheet.Columns.Hidden = False
   Application.ScreenUpdating = False
   For iCol = 7 To 999   ' K:GL
      Columns(iCol).Hidden = Cells(7, iCol).Value <> Range("A7").Value
   Next
     Application.ScreenUpdating = True
   Selection.AutoFilter Field:=4, Criteria1:=A7
End Sub

Den Code habe ich bei dem entsprechenden Tabellenblatt im Code eingepflegt.

Leider funktioniert gar nichts richtig.

Könnt Ihr mir helfen, wo ich den Fehler gemacht habe?

Danke

Czerno

Answer 1

Hallo dd

Ein Beispiel in Wechselwirkung!

Gruß Nighty

Sub SpaltenAusblenden()
    Dim DatenQuelle As Variant
    Dim SpIndex As Long
    If Cells.EntireColumn.Hidden = True Then
        Cells.EntireColumn.Hidden = False
    Else
        DatenQuelle = Range(Cells(1, 1), Cells(1, 11))    'Arrayübergabe Zeile1 Spalte 1 - 11
        For SpIndex = 1 To 11    'Durchlauf Zeile1 Spalte 1 - 11 gegebenenfalls anpassen
            If DatenQuelle(1, SpIndex) = "a" Then Daten = Daten & Cells(1, SpIndex).Address(False, False) & ","    'Suchbegriff "a" in Zeile1 Spalte 1 - 11
        Next SpIndex
        Range(Mid(Daten, 1, Len(Daten) - 1)).EntireColumn.Hidden = True
    End If
End Sub

Answer 2

Hallo Czerno .-)

Ops ... hatte den Namen übersehen!

Gruß Nighty

Answer 3

Guten Morgen Nighty,

vielen Dank für deine Antwort!

Ich stelle mich zwar gerade denke ich mega blöd an aber trotzdem muss ich mal nachfragen.

Dein Code habe ich genommen und mal ganz sturr einkopiert um zu schauen ob es funktioniert.

Ich bekomme den Fehler:
Laufzeitfehler 5
Ungültiger Prozeduraufruf oder ungültiges Argument

Bei Debuggen mosert er mir folgende Zeile gelb an:
 Range(Mid(Daten, 1, Len(Daten) - 1)).EntireColumn.Hidden = True

Grüße

Czerno

Answer 4

Hallo Czerno :-)

War auch nur ein Experiment und scheitert wohl an der Stringlänge!

Dann nach deinem Muster!

Sub Spalten()
    Dim iCol As Long
    Application.ScreenUpdating = False
    ActiveSheet.Columns.Hidden = False
    For iCol = 7 To 999
        If Cells(7, iCol).Value <> Range("A7").Value Then
        Cells(7, iCol).EntireColumn.Hidden = True
        End If
    Next
    Application.ScreenUpdating = True
    Selection.AutoFilter Field:=4, Criteria1:=A7
End Sub

Field:=4 > überdenke das mall

Gruß Nighty

Answer 5

Hallo Commuity und Czerno :-)

Experiment fortgesetzt!

Ziel war es das Ausblenden von Spalten zu beschleunigen!

Ein Splitten des Strings löste das Problem.

Das Limit der Zeichenanzahl eines String ist versionsabhängig

Zur Zeit ist >240 eingestellt,den Versionen anpassen >65 000,>1 000 000 etc

Es wird nach Strings ausgeblendet ,die eine Maximale Addressenkette beinhaltet!

Das Ausblenden von Gruppen dürfte wesentlich schneller sein!

Ein Ausblenden in einem Rutsch von beliebigen Datenmengen ist mir nicht bekannt.

Ausgehend von!

Suchbegriff Range("A7")

Ausblendung anhand der 7 Zeile,Spalte 7 bis 999

Sub SpaltenAusblenden()
    ReDim Daten(0) As String
    Dim DatenQuelle As Variant
    Dim SpIndex As Long, StIndex As Long, Zähler As Long
    ActiveSheet.Columns.Hidden = False
    DatenQuelle = Range(Cells(7, 1), Cells(7, 999))
    For SpIndex = 7 To 999
        If DatenQuelle(1, SpIndex) = Range("A7") Then
            'Stringlänge (Versionsabhängig),zur Sicherheit immer ca. 15abziehen
            If Len(Daten(Zähler)) > 240 Then
                Zähler = Zähler + 1
                ReDim Preserve Daten(Zähler)
            End If
            Daten(Zähler) = Daten(Zähler) & Cells(1, SpIndex).Address(False, False) & ","
        End If
    Next SpIndex
    For StIndex = 0 To UBound(Daten)
        Range(Mid(Daten(StIndex), 1, Len(Daten(StIndex)) - 1)).EntireColumn.Hidden = True
    Next StIndex
End Sub

Gruß Nighty

Answer 6

Hi Nighty,

vielen Dank für den Code. Er funktioniert einwandfrei nur eigentlich macht er nicht was ich will....

Er soll wenn in A7 eine 1 steht alle Spalten ungleich 1 ausblenden und nicht die 1 ausblenden.

Hast du eine Idee wie ich das ungleich lösen kann und nicht das gleich?

Ich weiß ich stelle mich ziemlich dumm an aber ich leider vollkommender neuling was VBA angeht.

Grüße und Dankeeeee

Czerno

Answer 7

Hallo Czerno

Einige operatoren

kleiner

<

größer

>

gleich

=

ungleich

<>

Größer oder gleich

>=

Kleiner oder gleich

<=

Ergänzend

Beschäftige dich mal mit or und and bei einer if abfrage

Wobei geschachtelte Anweisungen schneller sind

und or und and daher nicht die Regel sein sollte

Wenn in Range("A1") eine 1 steht,wird das Makro durchlaufen,siehe 5 Zeile

Anscliessend auf  <>1(Variablenname=Suche) ausgeblendet,9 Zeile ist die Abfrage

Sub SpaltenAusblenden()
    ReDim Daten(0) As String
    Dim DatenQuelle As Variant, Suche As Variant
    Dim SpIndex As Long, StIndex As Long, Zähler As Long
    Suche = Range("A7")
    If Suche = 1 Then
        ActiveSheet.Columns.Hidden = False
        DatenQuelle = Range(Cells(7, 1), Cells(7, 999))
        For SpIndex = 7 To 999
            If DatenQuelle(1, SpIndex) <> Suche Then
                If Len(Daten(Zähler)) > 240 Then
                    Zähler = Zähler + 1
                    ReDim Preserve Daten(Zähler)
                End If
                Daten(Zähler) = Daten(Zähler) & Cells(1, SpIndex).Address(False, False) & ","
            End If
        Next SpIndex
        For StIndex = 0 To UBound(Daten)
            Range(Mid(Daten(StIndex), 1, Len(Daten(StIndex)) - 1)).EntireColumn.Hidden = True
        Next StIndex
    End If
End Sub

Statt 240 könntest du auch mal 1000 einsetzen,da du ja eine neuere Version hast!

Um das Limit einiger Funktionen nicht zu überschreiten würde ich sagen das

1000 nicht überschritten werden sollte oder eben ausgiebig testen nit erhöhungen

Gemieden werden sollte,Verketten und Verbinden von Zellen

Gruß Nighty

Nochmal zum Autofilter

Die 4 durch eine 1 ersetzen!

Field:=4

Answer 8

Hallo Czerno

Zum Autofilter

Angenommen du benötigst 3 getrennte Suchkreterien

Spalte e ,Spalte g,Spalte J

Es wird nun der Autofilterbereich festgelegt,von e bis J durchgehend

Wir haben also Field 1 bis 6

Kreterien

Field 1

Field 3

Field 6

bei einem Kreterium ist die Field Angabe also immer 1

Gruß Nighty