Formel automatisch weiterscheiben am 3. des Folgemonats

04.12.2024 11:58:09

chris58

Hallo !
Ich hätte noch eine Frage bezüglich eines VBA-Codes. Den folgenden Code übertrage ich jeweils nach Ende des Monats in den nächsten Monat mittels eines Commandbutton2. Dies desswegen, da ansonst (also auf meinem Rechner) immense Wartezeit verbunden ist, wenn täglich eine Eintragung in ein Feld erfolgt und der Code die gesamten eingetragenen Formeln durchgeht. Meine Frage ist folgende:
Kann man das irgendwie machen, das der Übertrag "automatisch" jeweils am 3. des Folgendemonats erfolgt und dann auch, falls händisch ein weiterschreiben erfolgen sollte, darauf hingewiesen wird, das schon ein Übertrag für das Folgemonat gemacht wurde (sonst wird der ja nochmal um ein Monat weitergeschrieben) ? Geht sowas ? ..... oder alternativ..............eine Meldung am 1. des neuen Monats kommt, das ein weiterschreiben gemacht werden muß.
Danke für Eure Zeit
chris58

Hier der Code:;
Private Sub CommandButton2_Click()
Dim lngalteLetzteSpalte As Long
Dim lngneueLetzteSpalte As Long

If InputBox("Formeln werden jetzt in die nächste Spalte übertragen Welches Monat aktuell ist, zeigt die grüne Headline", "FORMELN WEITERKOPIEREN ?", vbYesNo) = vbYes Then
End If

lngalteLetzteSpalte = Cells(13, Columns.Count).End(xlToLeft).Column 'zeile 13
lngneueLetzteSpalte = lngalteLetzteSpalte + 1

Cells(3, lngalteLetzteSpalte).Resize(9).Copy 'zeile 3 bis 11
Cells(3, lngneueLetzteSpalte).Resize(9).PasteSpecial xlCellTypeFormulas

Cells(13, lngalteLetzteSpalte).Resize(4).Copy 'zeile 13,14,15,16
Cells(13, lngneueLetzteSpalte).Resize(4).PasteSpecial xlCellTypeFormulas
Application.CutCopyMode = False

Cells(1, lngalteLetzteSpalte).Resize(2).Interior.Color = xlNone ' zeile 1 und 2 --loescht gruen
Cells(1, lngneueLetzteSpalte).Resize(2).Interior.Color = vbGreen '--setzt gruen

With Cells(3, lngalteLetzteSpalte).Resize(18) 'zeile 3 bis 20
.Formula = .Value
End With

Range("B1").Select

MsgBox "FERTIG - Formeln wurden ain die nächste Spalte (grüne Headline) übertragen - Nur die Werte verblieben in vorheriger Spalte", vbInformation

End Sub

AW: Formel automatisch weiterscheiben am 3. des Folgemonats

04.12.2024 15:22:12

emkaes

Hallo,

deine Inputbox am Anfang deines Makro hat keinen Einfluß, das Makro wird immer komplett durchlaufen.
Deine lngneueletzteSpalte kann nur eine lngneueERSTESpalte sein, solltest du in deinem Code verändern, läßt sich dann für andere leichter nachvollziehen

Hier ist eine Abfrage, z.B. über eine MsgBox, das Mittel der Wahl, um zu entscheiden, ob die Formeln übertragen werden sollen oder nicht.
Da bei der Entscheidungsfindung offensichtlich ein Datum eine Rolle spielt und es sich um einen Folgemonat handelt, habe ich den Folgemonat des "Abfragetages" ermittelt.

Falls du eine Datumsangabe in Zeile1 und/oder Zeile2 in der lngalteletzteSpalte hast, kann man das selbstverständlich benutzen

Private Sub CommandButton2_Click() 

Dim lngalteLetzteSpalte As Long

Dim lngneueErsteSpalte As Long

Dim nxtMonth As String



nxtMonth = MonthName(Month(Date))



If MsgBox("Willst du die Formeln in die nächste Spalte für Monat " & nxtMonth & " übertragen?", vbYesNoCancel) = vbYes Then

        '.....dein Code

        '.....

       MsgBox "FERTIG - Formeln wurden in die nächste Spalte (grüne Headline) übertragen - Nur die Werte verbleiben in vorheriger Spalte", vbInformation 

End If



End Sub

Viele Gruesse

AW: Formel automatisch weiterscheiben am 3. des Folgemonats

05.12.2024 11:24:14

chris58

Hallo emkes !
Danke für Deine Hilfe. Ich habe Deine beiden Zeilen eingefügt und nun bekomme ich wenn ich es auf die nächste Spalte übertrage die Box, welche mich in die Lage versetzt, abzubrechen. Was ich nicht verstehe ist das mit dem Datum.
Klar, ich habe ab C1 den Monat und in C2 das Jahr stehen................läuft dann von C1 bis CH1 (Monat) und CH2 (Jahr).und dann halt irgendwann weiter...............
Wie könnte ich das nutzen um nicht den Übertrag der Formeln zu vergessen - also das Makro das automatisch abläuft ?
Aber jedenfalls danke für Zeit und für die Hilfe
chris58

AW: Formel automatisch weiterscheiben am 3. des Folgemonats

05.12.2024 15:51:00

emkaes

Hallo Chris,

meine Glaskugel ( Auswertung deines Codes ) sagt mir, dass du Formeln für einen "kommenden" Zeitraum überträgst und damit eine "spaltenweise nach rechts rollierende" Tabelle erhälst. Darüber hinaus ersetzt du die Formeln des "aktuellen" Zeitraums durch Werte.

Wenn dem so ist, dann überlege doch mal folgendes:
Du erstellst eine "ArchivTabelle", in die du die Werte bei Ablauf des Zeitraums kopierst und die Bezugsfelder deiner Formeln in der "Formeltabelle" entleerst. Damit hättest du dann deine "jungfräuliche Eingabetabelle" immer am Tabellenanfang ( Spalte A:xxx).

Aber falls ich deinen Code und deine Intention nicht erkannt habe, dein Makro automatisch gesteuert durch nachfolgende Codes:

für das automatische Triggern des deines Makros durch aktivieren der Tabelle über eine Abfrage, ob das Makro im Zeitraum 01. - 03. eines Monats bereits ausgeführt wurde, folgendes nutzen.

die Codes gehören in den Codebereich der Tabelle, in der du die Formeln koperen willst

Public Function getTransferFormula() As Boolean            'Customproperties sind sind les-und schreibbare Selbsterzeugbare

 Dim objProp As CustomProperty                             'Eigenschaften für Worksheets

  For Each objProp In CustomProperties                     ' wenn es eine Eigenschaft "Übertrag" gibt, liefere den gesetzten Wert ( true oder false ) zurück

   If objProp.Name = "Übertrag" Then getTransferFormula = objProp.Value

  Next

End Function





Public Sub setTransferFormula(pName As String, pValue As Boolean)

 Dim objProp As CustomProperty



   If CustomProperties.Count = 0 Then                      ' wenn noch keine Porperty existiert

      CustomProperties.Add Name:=pName, Value:=pValue      ' erstelle eine mit dem Namen Übertrag und übergebe True oder false

   Else

      For Each objProp In CustomProperties                 ' falls es eine mit dem Namen Übertrag gibt, überschreibe den Wert

         If objProp.Name = pName Then objProp.Value = pValue  ' mit dem Wert pValue

      Next

   End If

End Sub





Public Function deleteProp(pName As String) As Long         ' löscht die Property Übertrag und liefert bei Erfolg _1 ( wahr ) zurück

  Dim objProp As CustomProperty

   If CustomProperties.Count > 0 Then

      For Each objProp In CustomProperties

         If objProp.Name = pName Then

            objProp.Delete

            deleteProp = -1

         End If

      Next

   End If

End Function





Private Sub Worksheet_Activate()                 ' Makro startet bei aktivierung der Tabelle

   If Day(Date) >= 1 And Day(Date) = 4 Then     ' prüfen auf Monatsanfang ( 1.-4. des aktuellen Monats )

     If getTransferFormula Then                  ' prüfen ob bereits kopiert

        Exit Sub                                 ' wenn ja Ende des Makros

     Else                                        ' wenn neinn, dann

        MsgBox "Makroaufruf"                     ' zu testzwecken, kannst du auskommentieren oder löschen

        'Call deinMakro                          ' hier ergänzen mit dem Namen deines Makro für das Starten dieses Makros

        setTransferFormula "Übertrag", True      ' setzen des Flags, dass kopiert worden ist

     End If

   End If

End Sub

AW: Formel automatisch weiterscheiben am 3. des Folgemonats

05.12.2024 19:56:37

chris58

Hallo emkaes !
Also ich trau mich da nicht drüber, sonst geht dann nichts mehr.
Ich habe die vielen Tabellenblätter gelöscht und nur die beiden relevanten gelassen, damit man sieht, wie das aussieht.
Es war nur, damit ich das nicht immer übersehe, also das mit dem übertrag.
lg chris58

https://www.herber.de/bbs/user/174129.zip

AW: Formel automatisch weiterscheiben am 3. des Folgemonats

06.12.2024 14:26:54

emkaes

Hallo,

so isses, wenn Imagination auf Realität trifft; geht alles viel einfacher als ich das aufgrund der Auswertung deines Codes und meiner Vorstellung deiner Daten und Intention gedacht habe

Kommeniere mal deinen gesamten Code im Tabellenblatt History aus. ( kommplett markieren mit STRG + A und dann im Menue Debuggen "Block auskommentieren" ).
Damit "konservierst" du deinen funktionierenden Code und brauchst nicht zu befürchten, dass du alles zerschießt.

Füge meinen Code komplett ein und teste

Private Sub CommandButton1_Click()

ActiveWorkbook.FollowHyperlink Address:="https://echtsolar.de/photovoltaik-ertrag/", NewWindow:=True

End Sub

Private Sub CommandButton2_Click()

  Call deinAusgelagertesMakro(Cells(13, Columns.Count).End(xlToLeft).Column)

End Sub

Private Sub CommandButton3_Click()

Worksheets("Berechnung").Activate

ActiveSheet.Range("A2").Select

End Sub



Private Sub CommandButton4_Click()

ActiveWorkbook.FollowHyperlink Address:="https://www.oem-ag.at/de/marktpreis/", NewWindow:=True

End Sub



Private Sub Worksheet_Activate()

' Makro startet bei aktivierung der Tabelle

Dim lcol As Long

Dim Monat As Long



   lcol = Cells(13, Columns.Count).End(xlToLeft).Column

   If checkDate(lcol) Then

      MsgBox "alles gut"

   Else

      If MsgBox("neuer Monat? Formeln übertragen?", vbYesNoCancel) = vbYes Then

        Call deinAusgelagertesMakro(lcol)

      End If

   End If

   

End Sub



Sub deinAusgelagertesMakro(lcol)

    

    Dim neueSpalte As Long

              

    'If MsgBox("Willst du die Formeln in die nächste Spalte für Monat " & nxtMonth & " übertragen?", vbYesNoCancel) = vbYes Then

    

    

    neueSpalte = lcol + 1

    

    Cells(3, lcol).Resize(9).Copy  'zeile 3 bis 11

    Cells(3, neueSpalte).Resize(9).PasteSpecial xlCellTypeFormulas



    Cells(13, lcol).Resize(4).Copy 'zeile 13,14,15,16

    Cells(13, neueSpalte).Resize(4).PasteSpecial xlCellTypeFormulas

    Application.CutCopyMode = False

    

    Cells(1, lcol).Resize(2).Interior.Color = xlNone ' zeile 1 und 2 --loescht gruen

    Cells(1, neueSpalte).Resize(2).Interior.Color = vbGreen '--setzt gruen



    With Cells(3, lcol).Resize(18) 'zeile 3 bis 20

    .Formula = .Value

    End With

    Range("B1").Select

    MsgBox "FERTIG - Formeln wurden in die nächste Spalte (grüne Headline) übertragen - Nur die Werte verbleiben in vorheriger Spalte", vbInformation

'End If

End Sub



Function checkDate(spalte As Long) As Boolean

    'ist das aktuelle Datum in Formelspalte

  If Month(Date) = (spalte - 3) Mod 12 + 1 _

     And Cells(13, spalte).HasFormula Then checkDate = True

End Function

Was habe ich verändert und wie funktioniert das alles?

Ich habe deinen Code aus dem Commandbutton2_Click im Wesentlichen in die Sub DeinAusgelagertesMakro(lcol) ausgelagert.

Damit ist dieses weiter genauso zuverlässig und funktioniert wie bisher. Was dort verändert ist:
- die Begrifflichkeit lngalteletztespalte heißt jetzt lcol und wird beim Aufruf der Sub als Parameter übergeben
- die Begrifflichkeit lngneueletzteSpalte heißt jetzt neueSpalte
(ich tue mich halt mit diesen BandwurmVariablenNamen schwer)

warum ausgelagert? es wird auf 2 unterschiedliche Arten angeschubst:
entweder automatisch mit jedem aktivieren des Tabellenblattes "History"
oder immer noch manuell über deinen Commandbutton Wetterdaten

Es gibt jetzt neu die Ereignisprozedur Worksheet_activate() und die Function checkDate

Worksheet_Activate hat die Aufträge:
-welche SpaltenNummer ist die letzte in Zeile13 ( aus deinem Code kopiert )
-übergibt die SpaltenNummer an Checkdate
-wertet die Rückgabe aus ( wenn true zurückkommt nix machen, wenn false zurückkommt Fragen was zu tun ist
-nach Zustimmung das Makro zum Formel-kopieren aufrufen oder Code abbrechen. Dann kannst du ggfs prüfen, was zu tun ist

Function checkDate macht folgendes:
- es erhält die Spaltennummer
- prüft anhand der SpaltenNummer, um welcher Monat es sich in dieser Spalte handelt
- wenn es derselbe Monat ist wie das aktuelle Datum ist und der Eintrag in Zeile 13 eine Formel enthält wird true zurückgeliefert
- anderenfalls wird false zurückgeliefert

Falls du mit verschiedenen datumangaben testen willst, kannst du in Worksheet_activate die Variable lcol mit Spaltennummern unter Berücksichtigung der Zeile13 dieser Spalte mit oder ohne Formel hart codieren.

Ggfs. zur wiederherstellung deines "alten" Codes dann "meinen Code" löschen, wieder alles markieren und "Auskommentierung aufheben"

AW: Herzlichen Dank für den Aufwand

06.12.2024 17:56:39

chris58

Hallo emkaes !
Ich bin..................begeistert ist das falsche Wort. Du hast tatsächlich den gesamten von mir zusammengestopelten Code, den ich entweder hier oder in bescheidenen Teilen selbst gemacht habe, überarbeitet/ neu gemacht.
Ich habe mir zwar das ganze nun X-Mal durchgelesen und manches habe ich auch "geschnallt", aber das funktioniert und ob ich das genau verstanden habe ist eigentlich nicht so wichtig. Das mit dem auskommentieren .................. ich habe es so gemacht.............
ich habe von der Datei eine Kopie gemacht und da Deinen Code statt dem bisherigen reingkopiert. Habe dann das Datum am Rechner auf Jänner 2026 gestellt um es zu testen (da ich das mit dem Testen nicht so richtg verstanden habe). Da kommt der Hinweis ..................ist der Monat richtig ? (oder so halt).
Ich werden die beiden Dateien nebeneinander bis Anfang Jänner 2025 gleich führen, aber für mich scheint ist perfekt zu funktionieren.
Ich möchte mich sehr, sehr herzlich bedanken wünsche Dir ein schönes Wochenende ein gesegnetes Weihnachtsfest und einen guten Rutsch ins Neue Jahr.
Danke lg chris58

Formel automatisch weiterscheiben am 3. des Folgemonats

Forumthread: Formel automatisch weiterscheiben am 3. des Folgemonats

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Formel automatisch weiterscheiben am 3. des Folgemonats

Forumthread: Formel automatisch weiterscheiben am 3. des Folgemonats

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread