XL 2013 Incrémentation situation avec pourcentage (Résolu par JOB75)

susaita · 12 Septembre 2016

Bonjour le forum,

dans le fichier ci-joint j'ai essayé d'appliqué le même code fourni par JOB75 dans mon dernier post mais je trouve qu'il est un peu différent vu que je suis novice en VBA.
dans ce tableau en passant de SIT-00 que j'ai considéré comme feuille de début un message me demande de saisir le pourcentage souhaité et en mettant par exemple 40% il doit appliqué ce pourcentage sur les cellules E22 et E34 de SIT-01 qui va se créer et dans SIT-02 si je mets 45% il fera la même chose en prenant ce pourcentage du montant de la colonne E (onglet echeance) pour E22 et la colone F pour E34
dans Sit-03 si je met 15% il va prendre le reste du montant comme ça le total sera a 100% . donc dans SIT-04 le pourcentage que je saisirai il va le prendre de la ligne 16 de l'onglet Echeancier puisque on est déjà a 100 de la ligne 15 dans les trois premières situations.

dan sit-03 si je mets par exemple plus que 15% chose qui dépasse les 100% de la 1ere situation un message doit m'avertir que j'ai dépassé 100% de la situation en cours

le mois que j'ai sur B22 doit être le même de A12 que je saisirai à la main

Merci d'avance

job75 · 12 Septembre 2016

Bonjour susaita,

Pas cherché à comprendre : en tombant sur le message "Le nom _key2 existe déjà." j'ai refermé aussi sec le fichier.

C'est le nième projet que vous présentez, vous en faites collection ?

Et en mettant "Pour JOB75" dans le titre vous risquez de n'avoir aucune autre réponse que la mienne.

susaita · 12 Septembre 2016

Bonjour job, le forum
aufait c'est le dernier fichier que je présente en fin mois avec les autres,
pour le titre je croyais qu'en mettant <<pour...>> serait plus facile pour la personne qui a déjà travaillé dessus,
je m'excuse

susaita · 13 Septembre 2016

re,
j'ai retelechargé le fichier en copiant la trame dans un classeur propre pour éviter le message "Le nom _key2 existe déjà."

job75 · 13 Septembre 2016

Bonjour susaita, le forum,

Voyez le fichier joint et ce code :

Code:

Function MoisFormule$(c As Range, Optional incremente As Boolean, Optional formule As Boolean)
'utilisée dans la macro Situation et en B22 de la feuille de calcul
Dim txt$, i%, j%, dat$
txt = c.Formula
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then Exit For '1er chiffre
Next
For j = Len(txt) To 1 Step -1
    If IsNumeric(Mid(txt, j, 1)) Then Exit For 'dernier chiffre
Next
If j > i Then dat = Mid(txt, i, j - i + 1)
If Not IsDate(dat) Then Exit Function
If formule Then
  MoisFormule = Left(txt, i - 1) & Format(DateSerial(Year(dat), Month(dat) + 2, 0), "dd-mm-yyyy") & Mid(txt, i + Len(dat))
Else
  MoisFormule = UCase(Format(DateAdd("m", -incremente, dat), "mmmm yyyy"))
End If
End Function

Sub Situation()
Dim w As Worksheet, txt$, n%, OldName$, s1#, s2#, lig, pctmax#, colE, colF, numero$, pct#, vis
For Each w In Worksheets
  If Left(w.Name, 4) = "SIT-" Then If Left(w.Name, 6) > txt Then txt = Left(w.Name, 6)
Next
If txt = "" Then Exit Sub
For Each w In Worksheets
  If Left(w.Name, 7) = txt & "-" Then
    If Val(Mid(w.Name, 8)) > n Then
      n = Val(Mid(w.Name, 8))
      OldName = txt & "-" & n
      s1 = s1 + w.[E22]
      s2 = s2 + w.[E34]
    End If
  End If
Next
If n = 0 Then OldName = txt
With Sheets("ECHEANCIER")
  lig = Application.Match(Val(Mid(txt, 5, 2)), .[B:B], 0)
  If IsError(lig) Then Exit Sub
  pctmax = Application.Round(100 * (1 - s1 / IIf(.Cells(lig, "E") = "", 1, .Cells(lig, "E"))), 2)
  If pctmax = 0 Then n = 0: pctmax = 100: s1 = 0: s2 = 0
  If pctmax = 100 Then lig = lig + 1 'nouvelle tranche de travaux
  colE = .Cells(lig, "E")
  colF = .Cells(lig, "F")
  numero = Format(.Cells(lig, "B"), "00")
End With
Do
  txt = InputBox("Entrez le % des travaux réalisés ce mois :", _
    "SITUATION N° " & numero & IIf(n, "-" & n + 1, "") & " # FIN " & MoisFormule(Sheets(OldName).[A12], True), pctmax)
  If txt = "" Then Exit Sub
  pct = Application.Round(Abs(Val(Replace(Replace(txt, ",", "."), "%", ""))), 2)
Loop While pct > pctmax
Application.ScreenUpdating = False
Application.Goto ActiveSheet.[A1], True 'cadrage
'ThisWorkbook.Unprotect "susaita" 'déprotection du classeur, mdp à adapter
With Sheets(OldName)
    vis = .Visible
    .Visible = True 'si la feuille est masquée
    .Copy After:=Sheets(Sheets.Count)
    .Visible = vis
End With
With Sheets(Sheets.Count)
  '.Protect "susaita", UserInterfaceOnly:=True 'protection de la nouvelle feuille, mdp à adapter
  .Name = "SIT-" & numero & IIf(n Or pct < 100, "-" & n + 1, "")
  txt = MoisFormule(.[A12], True, True)
  If txt = "" Then
    MsgBox "Revoyez la formule en A12..."
  Else
    .[A12] = txt
  End If
  .[D22] = "='" & OldName & "'!C22"
  .[E22] = IIf(pct = pctmax, colE - s1, Application.Round(colE * pct / 100, 2))
  .[D34] = "='" & OldName & "'!C34"
  .[E34] = IIf(pct = pctmax, colF - s2, Application.Round(colF * pct / 100, 2))
  Application.Goto .[A1], True 'cadrage
End With
'ThisWorkbook.Protect "susaita" 'protection du classeur, mdp à adapter
End Sub

J'ai mis en commentaires les 3 lignes de code pour les protections du classeur et de la feuille créée.

A vous de voir susaita si vous voulez les utiliser.

Mais à mon avis il est plus prudent de les utiliser, même si vous êtes le seul utilisateur du fichier.

Bonne soirée.

susaita · 13 Septembre 2016

Bonsoir Job, le forum
merci infiniment pour le code c'est exactement ce que je souhaitais avoir,
il reste juste un seul point que j'ai oubliéqui concerne la cellule A12 :
chaque fin mois je saisirai cette date à la main et cette dernière elle est variable ça peut être 21 comme le 29 du mois,
et pour la changer à la main c'est stupide de séléctionner cette formule ="AU "&MAJUSCULE(TEXTE("30-04-2015";"jj mmmm aaaa")) pour changer la partie 30-04-2016 par la date souhaitée...
il est possible de faire un double clique et saisir dans un message affiché la date souhaité pour avoir sur la cellule A12 : (AU...+ la date saisie sur le message) ??
si non qu'est ce que vous proposez

EDIT: comme vous pouvez constatez sur le fichier joint.en passant de Sit-01-2 a SIT-02 j'ai saisi 100% alors que le résultat n'est pas à 100%. dans E22 je dois avoir 7000000 et E34 -420000 que j'ai eu dans la colonne Cumul alors que dans cette dernière je devrais avoir dans C22=11000000 et C34= -660000

merci encore une autre fois
Bonne soirée

job75 · 13 Septembre 2016

Re,

Il y avait en effet une petite erreur dans la macro Situation du post #5.

Je l'ai corrigée ainsi que le fichier (1).

Quant à ceci :

susaita à dit:
et pour la changer à la main c'est stupide de séléctionner cette formule ="AU "&MAJUSCULE(TEXTE("30-04-2015";"jj mmmm aaaa")) pour changer la partie 30-04-2016 par la date souhaitée...
il est possible de faire un double clique et saisir dans un message affiché la date souhaité

vous êtes un peu obsédé par le double-clic il me semble.

Il n'est pas du tout stupide de modifier la formule en A12, et c'est bien plus simple que d'y faire un double-clic.

En plus de la date vous pouvez si vous le voulez modifier son format et même le texte qui la précède, c'est prévu dans la fonction MoisFormule.

Bonne nuit.

susaita · 14 Septembre 2016

re,
merci beaucoup job
ca fonctionné

job75 · 14 Septembre 2016

Bonjour susaita, le forum,

Dans ce fichier (2) la variable incremente est un nombre de mois, c'est plus logique.

Si vous voulez que l'échéance en E47 soit à 45 jours fin de mois entrez-y la formule :

Code:

=MoisFormule(A12;1)+44

Edit : un lien utile :

Bonne journée.

job75 · 14 Septembre 2016

Re,

Si en plus du mois on veut récupérer la date elle-même on peut rendre la fonction matricielle :

Code:

Function MoisFormule(c As Range, Optional incremente&, Optional formule As Boolean)
'utilisée dans la macro Situation et en B22-E47 de la feuille de calcul
Dim txt$, i%, j%, dat$, a(1 To 2)
txt = c.Formula
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then Exit For '1er chiffre
Next
For j = Len(txt) To 1 Step -1
    If IsNumeric(Mid(txt, j, 1)) Then Exit For 'dernier chiffre
Next
If j > i Then dat = Mid(txt, i, j - i + 1)
If Not IsDate(dat) Then MoisFormule = "": Exit Function
If formule Then
  a(1) = Left(txt, i - 1) & Format(DateSerial(Year(dat), Month(dat) + incremente + 1, 0), "dd-mm-yyyy") & Mid(txt, i + Len(dat))
Else
  a(1) = UCase(Format(DateAdd("m", incremente, dat), "mmmm yyyy"))
End If
a(2) = CDate(dat)
MoisFormule = a 'vecteur horizontal
End Function

Par exemple en E47 pour l'autre manière légale de calculer les 45 jours fin de mois :

Code:

=FIN.MOIS(INDEX(MoisFormule(A12);2)+45;0)

Fichier (3).

A+

susaita · 14 Septembre 2016

Bonjour Job,
merci beaucoup pour l'importance que vous avez donné à ce sujet mais je n'ai vraiment pas compris qu'elle est la différence entre le dernier fichier posté hier et les deux que vous avez aujourd’hui ...

job75 · 14 Septembre 2016

Re,

J'ai pourtant bien précisé à chaque fois ce que fait la fonction MoisFormule !

Et pour terminer voyez ce fichier (4).

On considère qu'une facture émise avant le 15 du mois traite les travaux du mois précédent :

Code:

Function MoisFormule(c As Range, Optional incremente&, Optional formule As Boolean)
'utilisée dans la macro Situation et en B22-E47 de la feuille de calcul
Dim txt$, i%, j%, dat$, a(1 To 2)
txt = c.Formula
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then Exit For '1er chiffre
Next
For j = Len(txt) To 1 Step -1
    If IsNumeric(Mid(txt, j, 1)) Then Exit For 'dernier chiffre
Next
If j > i Then dat = Mid(txt, i, j - i + 1)
If Not IsDate(dat) Then MoisFormule = "": Exit Function
incremente = incremente + (Day(dat) < 15)
If formule Then
  a(1) = Left(txt, i - 1) & Format(DateSerial(Year(dat), Month(dat) + incremente + 1, 0), "dd-mm-yyyy") & Mid(txt, i + Len(dat))
Else
  a(1) = UCase(Format(DateAdd("m", incremente, dat), "mmmm yyyy"))
End If
a(2) = CDate(dat)
MoisFormule = a 'vecteur horizontal
End Function

A+

susaita · 14 Septembre 2016

re,
merci beaucoup pour cette modification importante je prends le dernier fichier

bonne journée

BoixosNois · 15 Septembre 2016

Bonsoir Job75, Susaita, le forum

en voulant m'inspirer de ce joli code pour l'appliquer sur un modèle de facture et même si j'ai pris le même tableau échéancier de votre exemple le résultat = 0 vu que je suis novice en VBA
mais dans ma facture que je vous joint je n'ai pas le A12 ni B22 et je ne souhaite pas copier l'ancien le cumul ...
les deux cellules dont je veux appliquer le pourcentage sont : C23 et C24
la date et le numéro de facture je préfère les saisir à la main
pouvez vous me donner un coup de main si ça vous intéresse???

Bonne nuit

job75 · 15 Septembre 2016

Bonjour le forum,

BoixosNois à dit:
Bonsoir Job75, Susaita, le forum

en voulant m'inspirer de ce joli code pour l'appliquer sur un modèle de facture et même si j'ai pris le même tableau échéancier de votre exemple le résultat = 0 vu que je suis novice en VBA
mais dans ma facture que je vous joint je n'ai pas le A12 ni B22 et je ne souhaite pas copier l'ancien le cumul ...
les deux cellules dont je veux appliquer le pourcentage sont : C23 et C24
la date et le numéro de facture je préfère les saisir à la main
pouvez vous me donner un coup de main si ça vous intéresse???

Bonne nuit

On sait, on sait BoisxosNois alias susaita etc...

Pour ceux qui ne sont pas au courant des divers pseudos utilisés :

https://www.excel-downloads.com/threads/hchhvkkfe.20010637/

Ce genre de chose ça se soigne.

Bonne journée.

XL 2013 Incrémentation situation avec pourcentage (Résolu par JOB75)

susaita

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

susaita

XLDnaute Occasionnel

susaita

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

susaita

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

susaita

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

susaita

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

susaita

XLDnaute Occasionnel

BoixosNois

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires