Excel Makro: in Zeile suchen, Spalten ein- und ausblenden

Hallo,

ich möchte in der Datei, in Zeile eins nach der KW suchen und mir dann den Bereich von z.b.: KW 1 einblenden lassen.

https://drive.google.com/file/d/0BzQM-ZoFrfL8WGNTUVEzV1pLNjQ/view?usp=sh ...

Irgendwie funktioniert es aber nicht.

Mit freundlichen Grüßen

Florian86

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 275408

Url: https://administrator.de/forum/excel-makro-in-zeile-suchen-spalten-ein-und-ausblenden-275408.html

Ausgedruckt am: 18.04.2025 um 05:04 Uhr

7 Kommentare

Neuester Kommentar

Hallo Florian,
machst du für dein Sheet mit folgendem Makro:
(Kommentare zu jeder Zeile stehen im Code)

Sub SearchKW()
    Dim f As Range
    strTitel = InputBox("Bitte geben Sie eine KW an!")  
    'Mit dem Bereich der Kalenderwochen arbeiten  
    With ActiveSheet.Range("E1:FD1")  
        'ScreenRefresh temporär deaktivieren  
        Application.ScreenUpdating = False
        'Bereich der Kalenderwochen temporär für die Suche einblenden  
        .EntireColumn.Hidden = False
        'Suche die Spalte der Kalenderwoche  
        Set f = .Find(strTitel, LookIn:=xlValues, LookAt:=xlPart)
        'Wurde sie gefunden  
        If Not f Is Nothing Then
            'Bereich wieder komplett verstecken  
            .EntireColumn.Hidden = True
            'Nur den Bereich (3 Spalten) der gefundenen Kalenderwoche einblenden  
            f.Resize(1, 3).EntireColumn.Hidden = False
        Else
            Msgbox "Kalenderwoche nicht gefunden!",vbExclamation  
        End If
        'ScreenRefresh wieder aktivieren  
        Application.ScreenUpdating = True
    End With
End Sub

Grüße Uwe

Du bist der Hit

Danke...

MfG

Florian86

Ist es möglich so auch mehrere KWs zu suchen und anzeigen zu lassen?
zB KW12,KW19,KW23 oder so?

LG

Zitat von @144026:

Hallo erst einmal,
[OT]
so viel Zeit sollte immer sein, das gebietet die Höflichkeit, hier sitzen ja noch immer Menschen die sich deiner Frage annehmen und Zeit aufwenden und keine Maschinen, Danke für das Beachten in Zukunft.
[/OT]

Ist es möglich so auch mehrere KWs zu suchen und anzeigen zu lassen?
zB KW12,KW19,KW23 oder so?

Ja, kein Problem, ein Array mit den Kalenderwochen durchlaufen, Range mit den einzublendenden Spalten bilden und am Ende diesen dann einblenden...

Sub SearchKW()
    Dim f As Range, arrKWs As Variant, kw As Variant, rngKWs As Range
    ' Array mit den Kalenderwochen  
    arrKWs = Array("KW12", "KW19", "KW23")  
    'Mit dem Bereich der Kalenderwochen arbeiten  
    With ActiveSheet.Range("E1:FD1")  
        'ScreenRefresh temporär deaktivieren  
        Application.ScreenUpdating = False
        'Bereich der Kalenderwochen temporär für die Suche einblenden  
        .EntireColumn.Hidden = False
        ' Alle angegebenen Kalenderwochen durchlaufen  
        For Each kw In arrKWs
            'Suche die Spalte der Kalenderwoche  
            Set f = .Find(kw, LookIn:=xlValues, LookAt:=xlPart)
            'Wurde sie gefunden  
            If Not f Is Nothing Then
                If Not rngKWs Is Nothing Then
                    Set rngKWs = Union(rngKWs, f.Resize(1, 3).EntireColumn)
                Else
                    Set rngKWs = f.Resize(1, 3).EntireColumn
                End If
            Else
                MsgBox "Kalenderwoche '" & kw & "' nicht gefunden!", vbExclamation  
            End If
        Next
        
        'Bereich wieder komplett verstecken  
        .EntireColumn.Hidden = True
        'und Bereiche der gewünschten Kalenderwochen einblenden  
        If Not rngKWs Is Nothing Then rngKWs.EntireColumn.Hidden = False

        'ScreenRefresh wieder aktivieren  
        Application.ScreenUpdating = True
    End With
End Sub

Grüße Uwe

Hallo,

vielen Dank für deine schnelle Antwort und sorry für die kurze Angebundenheit, du hast natürlich recht

Wäre es auch möglich, dass ich die Suche nach der KW eben in eine Messagebox selber eingebe? Also quasi so wie das erste Makro ganz oben. Da kann man ja EINE KW einigeben. Geht das selbe auch einfach mir mehreren KWs die ich eingbene kann? Getrennt mit einem Komma oder sowas?

Liebe Grüße

Zitat von @144026:
Wäre es auch möglich, dass ich die Suche nach der KW eben in eine Messagebox selber eingebe? Also quasi so wie das erste Makro ganz oben. Da kann man ja EINE KW einigeben. Geht das selbe auch einfach mir mehreren KWs die ich eingbene kann? Getrennt mit einem Komma oder sowas?

Kein Thema, einfach per Split den String in ein Array trennen

Sub SearchKW()
    Dim f As Range, arrKWs As Variant, kw As Variant, rngKWs As Range, strInput As String
    ' Eingabe abfragen  
    strInput = InputBox("Bitte geben Sie eine oder mehrere KWs mit Komma getrennt an!")  
    ' Array mit den Kalenderwochen anhand des Strings und Kommata splitten  
    arrKWs = Split(strInput,",",-1,1)  
    'Mit dem Bereich der Kalenderwochen arbeiten  
    With ActiveSheet.Range("E1:FD1")  
        'ScreenRefresh temporär deaktivieren  
        Application.ScreenUpdating = False
        'Bereich der Kalenderwochen temporär für die Suche einblenden  
        .EntireColumn.Hidden = False
        ' Alle angegebenen Kalenderwochen durchlaufen  
        For Each kw In arrKWs
            'Suche die Spalte der Kalenderwoche  
            Set f = .Find(Trim(kw), LookIn:=xlValues, LookAt:=xlPart)
            'Wurde sie gefunden  
            If Not f Is Nothing Then
                If Not rngKWs Is Nothing Then
                    Set rngKWs = Union(rngKWs, f.Resize(1, 3).EntireColumn)
                Else
                    Set rngKWs = f.Resize(1, 3).EntireColumn
                End If
            Else
                MsgBox "Kalenderwoche '" & Trim(kw) & "' nicht gefunden!", vbExclamation  
            End If
        Next
        
        'Bereich wieder komplett verstecken  
        .EntireColumn.Hidden = True
        'und Bereiche der gewünschten Kalenderwochen einblenden  
        If Not rngKWs Is Nothing Then rngKWs.EntireColumn.Hidden = False

        'ScreenRefresh wieder aktivieren  
        Application.ScreenUpdating = True
    End With
End Sub