VBA Excel problème de répartissions

turkiarra Messages postés 7 Date d'inscription   Statut Membre Dernière intervention   -  
lermite222 Messages postés 8724 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

J'ai créer un UserForm qui permet de remplir un tableau dans lequel on trouve entre autre une colonne avec un montant, une autre colonne avec la date de début de chantier et une 3ème colonne avec la durée prévisionnel du chantier en mois. Ensuite j'ai un mois par colonne pendant X années.

Ayant quelques connaissances sur VBA Excel j'arrive a remplir le tableau. Il me manque juste une fonction, que je n'arrive pas à trouver, qui permet de répartir le montant par mois selon le nombre de mois saisies.
Pour l'instant, avec la programmation que j'ai effectuée, j'arrive à selectionner la cellule correspondant à la date de début de chantier saisie et d'y mettre la valeur du montant diviser par le nombre de mois. Il faudrait ensuite répartir ce montant dans les mois qui suivent selon le nombre de mois saisie dans l'UserForm.

Si quelqu'un pourrait m'aider. Je vous joint la programmation que j'ai déja effectuée.
Si mes explications ne sont pas claires dites le moi j'essairai d'expliquer autrement.
Merci d'avance.

Voici le code de l'UserForm:

For i = 9 To 256
datesaisie = DateValue(DatePRO)
If Cells(6, i) = datesaisie Then
If Cells(n, 4) = "" Then
Cells(n, i) = Cells(n, 3).Value / Val(DuréePRO)
Else
Cells(n, i) = Cells(n, 4).Value / Val(DuréePRO)
End If
Exit For
End If
Next i

For j = 9 To 256
Datesaisie1 = DateValue(DateChantier)
If Cells(6, j) = Datesaisie1 Then
If Cells(n, 7) = "" Then
Cells(n, j) = Cells(n, 6).Value / Val(DuréeChantier)
'La fonction manquante qui permet de répartir le montant se trouverai ici
Else
Cells(n, j) = Cells(n, 7).Value / Val(DuréeChantier)
End If
Exit For
End If
Next j

Exit For
End If
Next n

Exit Sub
erreur_planning:
If Err = 13 Then
MsgBox " Vous devez taper une date PRO et une date Chantier "
End If

Range("A1").Select
Previssionnel.Hide
Unload Previssionnel
End Sub
A voir également:

2 réponses

Réponse 1 / 2
lermite222 Messages postés 8724 Date d'inscription   Statut Contributeur Dernière intervention   1 191
 
Bonjour,
Je ne comprebd pas très bien,
Tu aurais un montant .. ex: 1000 à répartir sur un nombre de mois ?
Mais le nombre de mois est tributaire des jours ex : du 31/1 au 1/2 il y a deux mois ? mais seulement 2 jours ?
Tu dis...
A+
0
turkiarra Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Oui j'ai un montant a répartir sur un nombre de mois sachant qu'une colonne de mon tableau represente un mois.
Par exemple si j'ai un montant de 1000 que je veux répartir sur 4 mois a partir du mois de février 2009, il faudrait que j'ai la valeur 250 dans la colonne Février 2009, puis dans la colonne Mars 2009, dans la colonne Avril 2009 et dans la colonne Mai 2009. Avec la programmation que j'ai effectué j'arrive juste a rentré la valeur 250 dans la première colonne, c'est à dire ici la colonne Février 2009, et je voudrai une fonction qui me permette de répartir ensuite cette valeur suivant le nombre de mois saisie.

Je sais pas si j'ai été plus clair.
Merci de t'être penché sur mon probleme lermite 222!
En esperant que tu trouve la solution...
0
Réponse 2 / 2
lermite222 Messages postés 8724 Date d'inscription   Statut Contributeur Dernière intervention   1 191
 
Une macro qui calcule la répartition en fonction des dates et des jours, si tu ne veux pas répartir en jour tu met DatDeb avec par exemple 1/1/2009 et dans datFin 31/7/2009
Mais supporte la répartition pondérée sur des dates complète comme 10/1/2009 au 21/7/2009 
Sub RépartirMontant()
Dim Ddep As Long, Dr  As Date
Dim DatDep As Date, DatFin As Date
Dim Montant As Single, Repartit As Single
Dim Buf As Byte, Lig As Long

    'exemple:
    Montant = 12000
    DatDep = "10/1/2009"
    DatFin = "21/7/2009"
    'calcul le nombre de jour en tout = 192 dans l'exemple
    Ddep = DateValue(DatFin) - DateValue(DatDep) + 1
    Repartit = Montant / Ddep 'répartit le montant sur le nombre de jours
    Lig = 3
    'Montant pour janvier
    Buf = calculJourMois(DatDep) - Day(DatDep) + 1
    With Sheets("feuil1")
        .Cells(Lig, 3) = Buf * Repartit
        For i = Month(DatDep) + 1 To Month(DatFin) - 1
            Lig = Lig + 1
            Dr = DateSerial(Year(DatDep), i, 1)
            Buf = calculJourMois(Dr)
            .Cells(Lig, 3) = Buf * Repartit
        Next i
        'Montant pour juillet
        Buf = calculJourMois(DatFin) - Day(DatFin)
        .Cells(Lig + 1, 3) = Day(DatFin) * Repartit
    End With
End Sub
Function calculJourMois(D As Date) As Byte
Dim D1 As Long, D2 As Long
Dim Mois As Integer
    D1 = DateSerial(Year(D), Month(D), 1)
    If Month(D) < 12 Then
        calculJourMois = DateSerial(Year(D), Month(D) + 1, 1) - D1
    Else
        calculJourMois = DateSerial(Year(D) + 1, 1, 1) - D1
    End If
End Function


Tu dis...
A+
PS: je n'ai pas pris en compte un éventuel changement d'année.
Si ce devait être le cas il faudra adapter.
0