Zeile ausblenden via VBA -> Variabel gestalten
09.09.2014 15:37:51
Dominic
ich verwende aktuell folgendes VBA Skript um bestimmte Zeilen in meiner Excel Tabelle aus- oder einzublenden.
Dieses Makro ist an einige Formularsteuerlemente verknüpft, so dass das Makro dann
ausgelöst wird und die jeweils gewünschten Zeilen aus- oder eingeblendet werden.
Kommen wir zum eigentlichen Problem. Ich muss bzw. möchte diese Liste variabler gestalten.
Heißt ich möchte nicht mehr bei jeder Änderung der Kundenbasis in das VBA Skript reingehen
und die Zeilen anpassen und editieren.
Im Tabellenblatt Datensammlungen werden in der Spalte X alle Kunden untereinander mit Namen aufgeführt.
Diese Kundenanzahl kann variabel sein.
Wie kann ich dieses Skript um folgenden Teil erweitern:
Prüfe im Tabellenblatt "Datensammlungen" ab Zelle X3 bis X400 (max. 400), (X1 und 2 enthalten Überschriften)
wie viele Zellen untereinander gefüllt sind. Hier werden alle Kunden nacheinander
aufgeführt. In dem aufgeführten VBA Beispiel sind es 181x Kunden heißt X3 bis X183 ist mit jeweils einem Kundennamen gefüllt.
Das u. aufgeführte Skript soll dann ausgehend von Startzeile 180 ausgehen und dazu (181 x 6 = 1.086 addieren ) = 1.266) an
besagter Stelle eintragen/ verwenden.
Angenommen in X3 bis X350 sind Kunden aufgeführt, sollte im Skript statt der 1.266 der Wert 2.262 stehen.
(Zusammensetzung wie gehabt: Startzeile = 180 + 348 Kunden (348x6= 2.088) = 2.268
Sub ZeileAusblenden()
Application.ScreenUpdating = False
With Sheets("Export")
With .Range("B14:T2050")
.ClearContents
.FormatConditions.Delete
.Borders.LineStyle = xlNone
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With .Cells
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.RowHeight = 17
.ColumnWidth = 15
'.UseStandardHeight = True
End With
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Ze As Long
If [B1] = 1 And [B2] = 1 And [P1] = 1 Then
Range("28:2340").EntireRow.Hidden = True
For Ze = 180 To 1266 Step 6
Rows(Ze + 1).EntireRow.Hidden = False
Next
End If
Range("B1:O8").Calculate
Range("O27:O28").Calculate
If [B1] = 2 And [B2] = 1 And [P1] = 1 Then
Range("28:2340").EntireRow.Hidden = True
Range("181:1266").EntireRow.Hidden = False
End If
Range("B1:O8").Calculate
Range("O27:O28").Calculate
If [B1] = 2 And [B2] = 1 And [P1] = 2 Then
Range("28:2340").EntireRow.Hidden = True
Range("181:1266").EntireRow.Hidden = False
Range("30:173").EntireRow.Hidden = False
Range("180:180").EntireRow.Hidden = False
End If
Range("B1:O8").Calculate
Range("O27:O28").Calculate
If [B1] = 1 And [B2] = 1 And [P1] = 2 Then
Range("28:2340").EntireRow.Hidden = True
Range("180:180").EntireRow.Hidden = False
For Ze = 180 To 1266 Step 6
Rows(Ze + 1).EntireRow.Hidden = False
Next
For Ze = 29 To 170 Step 6
Rows(Ze + 1).EntireRow.Hidden = False
Next
End If
Range("B1:O8").Calculate
Range("O27:O28").Calculate
Application.ScreenUpdating = True
End Sub