Tabelle um ein Jahr erweitern

Hallo,
letztes Jahr habe ich den richtigen Tipp hier im Forum bekommen wie man die Kosten zwischen mehreren Gas-Ableseterminen über die Monate und Jahre verteilt - vielen Dank hierfür. Nun wird das Thema durch die steigenden Gas-Preise spannend. Seitdem habe ich das Sheet stetig erweitert - siehe Anlage - vielleicht hat ja jemand das gleiche Thema.
Zwei kleinere VBA-Programme blenden Zeilen und Spalten aus und ein, damit man einen Ausdruck machen kann bzw. nur einzelne Jahre sieht.
Kann mir jemand einen Tipp geben, wie ich die zwei folgenden Probleme lösen kann:
a) Per Buttom soll das Sheet um ein "Jahr" (bzw. um 12 Spalten) erweitert werden. Normalerweise markiere ich die vorletzte Spalte und "ziehe" diese dann einfach um 12 Monate weiter.
b) Der Code des VBA-Programms Spaltenansicht (Dropbox in Zelle C2) wird nicht geändert, wenn 12 neue Spalten ergänzt wurden. Wie kann man hier die letzte Spalte dynamische in VBA ergänzen.
Z.B.:
'Prüfen, ob "2019" in Zelle C2 steht und blende die Monate vor 12/2018 und nach 01/2020 aus
ElseIf Range("C2").Value = "2019" Then
Columns("j:t").EntireColumn.Hidden = True
Columns("ai:bs").EntireColumn.Hidden = True
D.H. für "bs" müsste die Variable "xLastcolumn" (siehe Modul1) stehen.
Meine VBA-Kenntnisse sind leider begrenzt, so dass ich die beiden VBA-Routinen nicht zusammen bekomme.
Dank und Gruß
Volker
https://www.herber.de/bbs/user/156521.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Spaltenansicht 'Prüfen, ob wir in Zelle c2 sind If Not Intersect(Target, Range("c2")) Is Nothing Then Dim rng As Range, i& 'Spalten einblenden Cells.EntireColumn.Hidden = False Select Case Target.Value Case "Alle" Case 2018 To 2030 For i = Columns("J").Column To Cells(6, Columns.Count).End(xlToLeft).Column If Cells(6, i).Value Target.Value Then If rng Is Nothing Then Set rng = Cells(6, i) Else Set rng = Union(rng, Cells(6, i)) End If End If Next If Not rng Is Nothing Then rng.EntireColumn.Hidden = True Case Else End Select End If

Private Sub Worksheet_Activate() Dim s$, i& For i = Application.WorksheetFunction.Min(Rows(6)) To Application.WorksheetFunction.Max(Rows(6)) s = s & "," & i Next With Range("C2").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="Alle" & s .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub

man kann natürlich auch ein anderes Event-Makro nutzen. Je nachdem was besser passt.
Solltest du nun 2 Blätter in der Datei haben, die identischen Aufbau haben und in den Zellen auch die passende Datenüberprüfung haben, dann kann man den Code in das Workbook-Codemodul umlagern.
in DieseArbeitsmappe


Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
If Left(sh.Name, 3) = "Gas" Or Left(sh.Name, 3) = "Was" Then
Select Case Target.Address(0, 0)
Case "C2", "I5"
fillvalidation sh, sh.Range("C2,I5")
Case "F2"
If Target.Value = "Group" Then
sh.Outline.ShowLevels RowLevels:=1
sh.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
'Prüfen, ob "Ungroup" in Zelle F2 steht
ElseIf Target.Value = "Ungroup" Then
sh.Outline.ShowLevels RowLevels:=3
sh.Outline.ShowLevels RowLevels:=0, ColumnLevels:=3
End If
End Select
End If
End Sub

dazu in ein Allgemeines Modul die angepasste Validation sub


Sub fillvalidation(sh As Worksheet, rng As Range)
'Spaltenansicht
'Dieser Code füllt die Dropdown-Box mit den Jahreszahlen die beim Aktivieren des Blattes in Zeile 6 stehen
Dim s$, i&
For i = Application.WorksheetFunction.Min(sh.Rows(6)) To Application.WorksheetFunction.Max(sh.Rows(6))
s = s & "," & i
Next
With rng.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Alle" & s             'füge "Alle" noch zur Liste hinzu
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub

Das Problem a) ist schon etwas aufwendiger,oder?
Es ist nicht damit getan 12 Spalten zuzufügen. Was ist mit den Summenformeln und neuen Zeilen in den Eingabebereichen "A-I"?

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