Spalten ausblenden

Hallo,
ich habe schon viel gegooglet und herausgefunden, dass ich das was ich will mit Makros erreichen kann. Leider konnte ich die Lösungen für die Probleme der anderen (das heißt, ich hab eigentlich nur einen vergleichbaren Beitrag gefunden)nicht nachvollziehen und deshalb nicht auf mein Problem anwenden...
Kurz zur Erläuterung:
Ich erstelle einen Übersichtsplan, welcher Mitarbeiter (MA) wann arbeitet. Die MA arbeiten in jeder Abteilung unterschiedlich.
um das ganze jetzt etwas anschaulicher gestalten zu können, will ich gerne, dass die Tage, in der die Abteilung geschlossen ist, ausgeblendet werden.
In meinem Beispiel ist Di, Do, Sa und So geschlossen.
https://www.herber.de/bbs/user/103082.xlsx
Wie kann ich denn jetzt erreichen, dass die jeweiligen Spalten ausgeblendet werden, wenn sich der Monat ändert.
Ich will sie nicht immer manuell ausblenden müssen...
ich hoffe mir kann einer von euch helfen :)
Liebe Grüße
Sarah

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim iSpalte As Byte Application.ScreenUpdating = False For iSpalte = 4 To Range("IV3").End(xlToLeft).Column Select Case WorksheetFunction.Weekday(Cells(3, iSpalte)) Case 7, 1, 3, 5 Columns(iSpalte).Hidden = True Case Else Columns(iSpalte).Hidden = False End Select Next iSpalte Application.ScreenUpdating = True End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address(0, 0) = "A1" Then Dim iSpalte As Byte With Sh Application.ScreenUpdating = False For iSpalte = 4 To .Range("IV3").End(xlToLeft).Column Select Case WorksheetFunction.Weekday(.Cells(3, iSpalte)) Case 7, 1, 3, 5 .Columns(iSpalte).Hidden = True Case Else .Columns(iSpalte).Hidden = False End Select Next iSpalte Application.ScreenUpdating = True End With End If End Sub

Hi Sarah
So, jetzt wo ich wieder bei der Arbeit bin, habe ich Zeit für Makros :)
https://www.herber.de/bbs/user/103176.xlsm

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A1" Or Target.Address(0, 0) = "B1" Then
Dim iSpalte As Byte, iiSpalte As Byte, iZeile As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Übersicht")
For Each ws1 In ThisWorkbook.Worksheets
If ws1.Name  ws2.Name Then
With ws1
Application.ScreenUpdating = False
For iSpalte = 4 To .Range("IV3").End(xlToLeft).Column
If WorksheetFunction.CountIf(ws2.Columns(1), ws1.Name) = 0 Then
MsgBox "Die Abteilung " & ws1.Name & " fehlt auf dem Arbeitsblatt " & ws2. _
Name
Else
iZeile = Application.Match(ws1.Name, ws2.Columns(1), 0)
iiSpalte = Application.Match(WorksheetFunction.Weekday(ws1.Cells(3, iSpalte) _
), ws2.Rows(2), 0)
If ws2.Cells(iZeile, iiSpalte) = "x" Then
ws1.Columns(iSpalte).Hidden = False
Else
ws1.Columns(iSpalte).Hidden = True
End If
End If
Next iSpalte
Application.ScreenUpdating = True
End With
End If
Next ws1
End If
End Sub

Blatt Übersicht trägst du ein, wann die einzelnen Abteilungen arbeiten.
Beachte: Code muss jetzt ins Modul von "Tabelle1" resp. "AbteilungA" (nicht Standardmodul und neu auch nicht unter DieseArbeitsmappe).
Viel Spass
Chris

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "A1" Or Target.Address(0, 0) = "B1" Then Dim iSpalte As Byte, iiSpalte As Byte, iZeile As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws2 = ThisWorkbook.Worksheets("Übersicht") For Each ws1 In ThisWorkbook.Worksheets If ws1.Name ws2.Name Then With ws1 Application.ScreenUpdating = False For iSpalte = 4 To 40 If WorksheetFunction.CountIf(ws2.Columns(1), .Name) = 0 Then MsgBox "Die Abteilung " & ws1.Name & " fehlt auf dem Arbeitsblatt " & ws2. _ Name Else iZeile = Application.Match(.Name, ws2.Columns(1), 0) iiSpalte = Application.Match(WorksheetFunction.Weekday(.Cells(3, iSpalte)), _ ws2.Rows(2), 0) If ws2.Cells(iZeile, iiSpalte) = "x" Then ws1.Columns(iSpalte).Hidden = False Else ws1.Columns(iSpalte).Hidden = True End If End If Next iSpalte Application.ScreenUpdating = True End With End If Next ws1 End If End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread