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

cibleo · 24 Août 2012

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.

VB:

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 · 24 Août 2012

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

Bonjour,

essaye peut être ceci :

Code:

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 · 24 Août 2012

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.

VB:

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

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

cibleo

XLDnaute Impliqué

Pièces jointes

Pierrot93

XLDnaute Barbatruc

cibleo

XLDnaute Impliqué

Discussions similaires