Verkürzung Makro Spalten

Hallo liebe VBA Experten,
Kann man diesen Makro-Satz ein wenig verkürzen? Würde es dann auch schneller gehen?
Vielen Dank für eure Hilfe!

Sub Auswahl_Teilmärkte_MB2()
Dim Spalte1 As Long, Spalte2 As Long, Spalte3 As Long
Application.ScreenUpdating = False
Blattschutz_aus
Spalte1 = 11
Spalte2 = 42
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = False
End With
If Worksheets("Überblick_Markt").Range("BB19").Value = 0 Then
Spalte1 = 11 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = False
End With
End If
If Worksheets("Überblick_Markt").Range("BC19").Value = 0 Then
Spalte1 = 13 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BD19").Value = 0 Then
Spalte1 = 15 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BE19").Value = 0 Then
Spalte1 = 17 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BF19").Value = 0 Then
Spalte1 = 19 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BG19").Value = 0 Then
Spalte1 = 21 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BH19").Value = 0 Then
Spalte1 = 23 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BI19").Value = 0 Then
Spalte1 = 25 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BJ19").Value = 0 Then
Spalte1 = 27 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BK19").Value = 0 Then
Spalte1 = 29 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BL19").Value = 0 Then
Spalte1 = 31 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BM19").Value = 0 Then
Spalte1 = 33 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BN19").Value = 0 Then
Spalte1 = 35 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BO19").Value = 0 Then
Spalte1 = 37 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BP19").Value = 0 Then
Spalte1 = 39 'Spalte K
Spalte2 = Spalte1 + 1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
If Worksheets("Überblick_Markt").Range("BQ19").Value = 0 Then
Spalte1 = 41 'Spalte K
Spalte2 = Spalte1
Spalte3 = 42  'Spalte AO
With Worksheets("Überblick_Teilmarkt")
.Range(.Columns(Spalte1), .Columns(Spalte2)).EntireColumn.Hidden = True
End With
End If
End Sub

Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Erich,
vielen Dank fuer die schnelle Rueckmeldung. Du hast Recht, Spalte 3 ist nicht mehr notwendig. Hatte noch auf eine andere Art damit rumgespielt und zum Schluss vergessen die spalte3 rauszunehmen.
Ich lasse am Anfang erstmal alle Spalten einblenden, da ich oft die Erfahrung gemacht habe, dass erst durch die komplette Einblendung aller Spalten, die neu auszublendenden sich korrekt ausblenden lassen.
Bei BB19 soll die Spalte nie ausgeblendet werde , da mir dadurch das Layout verrissen wird. Eigentlich haette ich Bb19 gar nicht auffuehrrn muessen- dann wuerde es schon mal schneller werden - die Nacht war leider sehr lang - daher wohl einige unnoetige Inhalte im Makro.
Fazit: sobald eines der Zahlen eine 1 ist, soll die entsprechende Spalte ausgeblendet werden.
Vielen herzlichen Dank!
Stefan

Option Explicit Sub Neu_Auswahl_Teilmärkte_MB2() Dim lngS As Long, arrS(55 To 69) As Boolean Dim rngEin As Range, rngAus As Range ' Application.ScreenUpdating = False ' NACH DEM TEST evtl. aktivieren Blattschutz_aus ' für welches Blatt? With Worksheets("Überblick_Markt") For lngS = 55 To 69 arrS(11) = .Cells(19, lngS).Value = 0 Next lngS End With With Worksheets("Überblick_Teilmarkt") Set rngEin = .Cells(1, 11).Resize(, 2) ' Spalten 11+12 immer einblenden For lngS = 55 To 69 If arrS(lngS) Then Set rngEin = Union(rngEin, .Cells(1, 2 * lngS - 97).Resize(, 2)) Else If rngAus Is Nothing Then Set rngAus = .Cells(1, 2 * lngS - 97).Resize(, 2) Else Set rngAus = Union(rngAus, .Cells(1, 2 * lngS - 97).Resize(, 2)) End If End If Next lngS End With rngEin.EntireColumn.Hidden = False If Not rngAus Is Nothing Then rngAus.EntireColumn.Hidden = True ' Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread