Fonction personnalisée renvoyant une date au 10, 20 ou dernier jour du mois suivant

[cibleo]

Bonjour le forum,

En colonne B, au regard des dates figurant en colonne A doit être calculée une date selon les critères suivants :
Si la date se situe entre le 01 et 10 du mois, la date retenue sera la date au 10 du mois suivant.
Ex : A2 = 07.01.2012 -----> B2 = 10.02.2012

Si la date se situe entre le 11 et 20 du mois, la date retenue sera la date au 20 du mois suivant.
Ex : A2 = 13.03.2012 -----> B2 = 20.04.2012

Si la date se situe entre le 21 et le dernier jour du mois, la date retenue sera la date au dernier jour du mois suivant.
Ex : A2 = 31.01.2012 -----> B2 = 29.02.2012
Ex : A2 = 30.04.2012 -----> B2 = 31.05.2012
Ex : A2 = 21.09.2012 -----> B2 = 31.10.2012
Ex : A2 = 23.03.2012 -----> B2 = 30.04.2012

J'ai créé une fonction personnalisée avec 1 paramètre (la date prise en compte).
j'aimerais y ajouter 1 deuxième paramètre ---> le décalage en mois

Ex : je fixe le paramètre à 1
A2 = 21.07.2012 -----> B2 = 31.08.2012
Ex : je fixe le paramètre à 2
A2 = 21.07.2012 -----> B2 = 30.09.2012

Je vous envoie ce que j'ai réalisé en espérant pouvoir nettement l'améliorer.

Function DateButoir(d As Date)
Dim x As Date
x = d
finmois = WorksheetFunction.Min(DateSerial(Year(x), Month(x) + 1, 0), DateSerial(Year(x), Month(x) + 1, Day(x)))
finmois = CDate(finmois)
Select Case Day(x)
  Case Is <= 10
    Do Until Day(x) = 10
      x = x + 1
    Loop
    DateButoir = WorksheetFunction.Min(DateSerial(Year(x), Month(x) + 1 + 1, 0), DateSerial(Year(x), Month(x) + 1, Day(x)))
  Case Is <= 20
    Do Until Day(x) = 20
      x = x + 1
    Loop
    DateButoir = WorksheetFunction.Min(DateSerial(Year(x), Month(x) + 1 + 1, 0), DateSerial(Year(x), Month(x) + 1, Day(x)))
  Case Is <= 31
    Do Until Day(x) = Day(finmois)
      x = x + 1
    Loop
    ladate = DateSerial(Year(x), Month(x) + 1, 1)
    ladate = WorksheetFunction.Min(DateSerial(Year(ladate), Month(ladate) + 1 + 1, 0), DateSerial(Year(ladate), Month(ladate) + 1, Day(ladate))) - 1
    DateButoir = ladate
End Select
End Function

Merci d'avance pour les solutions qui seront apportées.

Cibleo

 

[Pierrot93]

Re : Fonction personnalisée renvoyant une date au 10, 20 ou dernier jour du mois suiv

Bonjour,

essaye peut être ceci :

Function DateButoir(d As Date)
If Day(d) <= 10 Then
    DateButoir = DateSerial(Year(d), Month(d) + 1, 10)
    ElseIf Day(d) <= 20 Then DateButoir = DateSerial(Year(d), Month(d) + 1, 20)
    Else
    DateButoir = DateSerial(Year(d), Month(d) + 2, 0)
End If
End Function

bon après midi
@+

 

[cibleo]

Re : Fonction personnalisée renvoyant une date au 10, 20 ou dernier jour du mois suiv

Salut Pierrot

Qu'est-ce que j'aime me compliquer la vie

J'ai rajouté un argument à ta fonction
Je peux ainsi décaler les dates butoirs dans le temps.

Function DateButoir(d As Date, p As Byte)
If Day(d) <= 10 Then
DateButoir = DateSerial(Year(d), Month(d) + p, 10)
ElseIf Day(d) <= 20 Then DateButoir = DateSerial(Year(d), Month(d) + p, 20)
Else
DateButoir = DateSerial(Year(d), Month(d) + 1 + p, 0)
End If
End Function

Retranscrite comme ceci en B2 en décalant de 2 mois

=DateButoir(A2;2)

Je vais continuer à tester on ne sait jamais avec les dates
Mille mercis Pierrot