Thema Datum  Von Nutzer Rating
Antwort
Rot Datum + Intervall
28.02.2024 21:17:36 Dirk
NotSolved
29.02.2024 07:25:19 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Dirk
Datum:
28.02.2024 21:17:36
Views:
425
Rating: Antwort:
  Ja
Thema:
Datum + Intervall

Hallo zusammen,

Mit folgender Programmierung wird anhand eines Datums eine "1" in die Spalte gesetzt mit dem passenden  Monat. Anhand eines Intervalls,werden weitere "1" gesetzt.

beispiel: ich habe das Datum 07.06.2024 und ein Intervall von 3 also wird in die Spalte Juni eine 1 gesetzt, in September und Dezember. 
bis hierhin funktioniert auch alles. Nun möchte ich aber das in den Intervallen weiter "1"gesetzt werden, bis Dezember 2026 und da hapert es. Meine Programmierung endet mit Dezember 2024. kann hier wer helfen?

 

Sub setIntervall(rng As Range)
   
    Dim dtDatum As Date
    Dim interv As Integer, lastcol As Integer, i As Integer
    Dim res As Variant
    Dim strMonth As String
    
    interv = rng.Value ' Anzahl der Monate, in die das Jahr aufgeteilt werden soll
   
    lastcol = Cells(9, Columns.Count).End(xlToLeft).Column
   
    If interv > 0 Then
                     
        dtDatum = rng.Offset(0, 1).Value
       
        For i = 1 To 12
            If Month(dtDatum) = i Then
                strMonth = MonthName(i) & " " & Year(dtDatum)
                res = Application.Match(strMonth, Rows("9:9"), 0)
                If IsNumeric(res) Then
                    Dim j As Integer
                    For j = i To 12 Step interv ' Beginne im aktuellen Monat und wiederhole das Intervall über das Jahr
                        strMonth = MonthName(j) & " " & Year(dtDatum)
                        res = Application.Match(strMonth, Rows("9:9"), 0)
                        If IsNumeric(res) Then
                            Cells(rng.Row, res).Value = 1
                        End If
                    Next j
                End If
                Exit For
            End If
        Next i
       
    Else
        Cells(rng.Row, 21).Resize(1, lastcol - 3).ClearContents
    End If
    Application.EnableEvents = True
   
End Sub

    

    interv = rng.Value ' Anzahl der Monate, in die das Jahr aufgeteilt werden soll

   

    lastcol = Cells(9, Columns.Count).End(xlToLeft).Column

   

    If interv > 0 Then

                     

        dtDatum = rng.Offset(0, 1).Value

       

        For i = 1 To 12

            If Month(dtDatum) = i Then

                strMonth = MonthName(i) & " " & Year(dtDatum)

                res = Application.Match(strMonth, Rows("9:9"), 0)

                If IsNumeric(res) Then

                    Dim j As Integer

                    For j = i To 12 Step interv ' Beginne im aktuellen Monat und wiederhole das Intervall über das Jahr

                        strMonth = MonthName(j) & " " & Year(dtDatum)

                        res = Application.Match(strMonth, Rows("9:9"), 0)

                        If IsNumeric(res) Then

                            Cells(rng.Row, res).Value = 1

                        End If

                    Next j

                End If

                Exit For

            End If

        Next i

       

    Else

        Cells(rng.Row, 21).Resize(1, lastcol - 3).ClearContents

    End If

    Application.EnableEvents = True

   

End Sub


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Datum + Intervall
28.02.2024 21:17:36 Dirk
NotSolved
29.02.2024 07:25:19 ralf_b
NotSolved