Macro pour division d'une donnée sur plusieurs lignes Résolu

Question

Bonjour, 

j'ai un tableau .xl dans lequel se trouvent une liste de dépenses avec, chacune, toute une série d'attributs (type, quantités, description etc).

Cela a donc le format qui suit :
"formation" en case A2; "soirées" en case B2 "62" en C2 etc

Puis en L2 apparait l'attribut période qui peut être un mois défini (janv/fev etc.) ou "année" lorsque cela ne peut pas être réparti sur un mois précis.

J'aimerais intégrer une macro qui :
- analyserait les différentes lignes et, lorsque l'attribut "année" apparaît en colonne L, créérait 12 nouvelles lignes avec exactement les mêmes attributs sauf : le montant qui serait divisé par 12 et "année" qui deviendrait donc janvier/février/mars etc.

Sauriez-vous m'aider ?

https://www.cjoint.com/?DJErkiu7CbR

Merci d'avance pour votre aide !

pijaku · Answer

Bonjour,
Pour transmettre un fichier, il faut passer par un site de pièce jointe tel que cjoint.com

Va sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

Edoardo · Answer

Merci beaucoup, fichier intégré !

pijaku · Answer

oui. ok. Mais il est ou le lien???

Edoardo · Answer

Dans mon 1er message. Le voici https://www.cjoint.com/?DJErkiu7CbR

pijaku · Answer

Bonjour,

J'ai regardé votre fichier, il ne correspond pas à ce que l'on attend. Il faudrait qu'il soit constitué d'une cinquantaine de lignes et de la même manière que votre fichier actuel. Nul besoin de nous mettre ce que vous attendez de la macro, ça nous avons compris. 
De plus, il nous faut savoir ou se situent les mots "ANNEE". Peut-on le trouver entre deux mois autres que Décembre et Janvier? 

EDIT : en clair le fichier transmis doit être conforme à votre fichier, dans son état actuel. Mais sans données confidentielles...

&#127932; Cordialement,
Franck &#127926;

pijaku · Answer

Voici le code.
Essaye le au préalable sur une copie de ton fichier.
Si trop lent ou en cas d'erreur, reviens me dire ce qu'il en est...
Option Explicit

Sub Annee_Mois()
Dim Tb_Donnees(), Lig As Long, DLig As Long, Lignes As Integer

DLig = Range("A" & Rows.Count).End(xlUp).Row
Tb_Donnees = Range("A2:O" & DLig).Value
For Lig = UBound(Tb_Donnees) To LBound(Tb_Donnees) Step -1
    If Tb_Donnees(Lig, 10) <> "A ENGAGER" And UCase(Tb_Donnees(Lig, 14)) = "ANNEE" Then
        Rows(Lig + 2 & ":" & Lig + 12).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        For Lignes = 1 To 12
            Cells(Lig + Lignes, 1) = Tb_Donnees(Lig, 1)
            Cells(Lig + Lignes, 2) = Tb_Donnees(Lig, 2)
            Cells(Lig + Lignes, 3) = Tb_Donnees(Lig, 3)
            Cells(Lig + Lignes, 4) = Tb_Donnees(Lig, 4)
            Cells(Lig + Lignes, 5) = Tb_Donnees(Lig, 5)
            Cells(Lig + Lignes, 6) = Tb_Donnees(Lig, 6)
            Cells(Lig + Lignes, 7) = Tb_Donnees(Lig, 7)
            Cells(Lig + Lignes, 8) = Tb_Donnees(Lig, 8)
            Cells(Lig + Lignes, 9) = Tb_Donnees(Lig, 9)
            Cells(Lig + Lignes, 10) = Tb_Donnees(Lig, 10) / 12
            Cells(Lig + Lignes, 11) = Tb_Donnees(Lig, 11)
            Cells(Lig + Lignes, 12) = Tb_Donnees(Lig, 12)
            Cells(Lig + Lignes, 13) = Tb_Donnees(Lig, 13)
            Cells(Lig + Lignes, 14) = UCase(Format(DateSerial(2014, Lignes, 1), "mmmm"))
            Cells(Lig + Lignes, 15) = Tb_Donnees(Lig, 15)
        Next
    End If
Next
End Sub

Edoardo · Answer

C'est tout bonnement magique !! Testé dans un fichier isolé puis dans mon fichier de travail et cela marche parfaitement. Le traitement prend environ 1 minute pour l'ensemble des lignes ce qui est plus que raisonnable !!!

merci BEAUCOUP !!!!!!

Edoardo · Answer

Bonjour, je dois désormais ajuster ma répartition du poste "année" non pas sur 12 mois mais uniquement sur les mois a venir (avril à décembre) : existe-t'il une façon d'ajuster le code dans ce but ?

Macro pour division d'une donnée sur plusieurs lignes

8 réponses

Discussions similaires

Newsletters