Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

chtico · 13 Septembre 2011

Bonjour,

J'essaie de créer un formulaire de saisie de commandes clients, pour lesquels certaines ont une périodicité au mois, au trimestre ou à l'année.
J'aimerais que certains montants, quand le critère période est sur Trimestre, génèrent autant de lignes qu'il y a de trimestre entre mon mois de facturation et une fin de période à 5 ans, et que chaque ligne calcule le mois de correspondance.
Par contre quand le critère période est sur Aucun, une seule ligne doit être générée.
En espérant avoir exprimé convenablement ma problématique, quelqu'un peut-il m'apporter ses lumières, je sèche.
Merci

JNP · 13 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour Chtico 🙂,
A tester

Code:

Sub Macro1()
Dim CC As Byte, NL As Integer, PE As Byte, I As Integer
NL = Sheets("Suivi CA").Range("A" & Cells.Rows.Count).End(xlUp).Row
Select Case Sheets("Formulaire").Range("B12")
    Case "Aucune"
        PE = 0
    Case "Mois"
        PE = 1
    Case "Trimestre"
        PE = 3
    Case "Année"
        PE = 12
End Select
If PE = 0 Then
    For CC = 1 To 8
        Sheets("Suivi CA").Cells(NL + 1, CC) = Sheets("Formulaire").Range("B" & CC * 2 + 2)
    Next CC
Else
    For I = 1 To 60 / PE
        For CC = 1 To 8
            Sheets("Suivi CA").Cells(NL + 1, CC) = Sheets("Formulaire").Range("B" & CC * 2 + 2)
        Next CC
        If I > 1 Then
            Sheets("Suivi CA").Cells(NL + 1, 4) = DateAdd("m", PE, Sheets("Suivi CA").Cells(NL, 4))
        End If
        NL = NL + 1
    Next I
End If
End Sub

Bon courage 😎

Grand Chaman Excel · 13 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour chtico,

Voici une proposition :

Code:

Sub Valider()
    Dim Tablo() As Variant
    Dim Periode As String
    Dim i As Integer
    Dim NbPaiements As Integer
    Dim rg As Range
    
    Periode = Sheets("Formulaire").Range("B12")
    
    Select Case Periode
        Case "Aucune": NbPaiements = 1
        Case "Année": NbPaiements = 5           '5 ans
        Case "Trimestre": NbPaiements = 20      '5 ans x 4 trimestres
        Case "Mois": NbPaiements = 60           '5 ans x 12 mois
    End Select
        
    ReDim Tablo(1 To NbPaiements, 1 To 8)

    With Sheets("Formulaire")
        'initialisation du tablo
        Tablo(1, 1) = .Range("B4")      'client
        Tablo(1, 2) = .Range("B6")      'produit
        Tablo(1, 3) = .Range("B8")      'montant facturé
        Tablo(1, 4) = .Range("B10")     'mois facturation
        Tablo(1, 5) = .Range("B12")     'périodicité
        Tablo(1, 6) = .Range("B14")     'statut
        Tablo(1, 7) = .Range("B16")     'montat achat sur CA HT
        Tablo(1, 8) = .Range("B18")     'mois commande achat sur CA HT
        
        If NbPaiements > 1 Then  'si plus que 1 paiement
            For i = 2 To UBound(Tablo, 1)
                Tablo(i, 1) = .Range("B4")
                Tablo(i, 2) = .Range("B6")
                Tablo(i, 3) = .Range("B8")
                Tablo(i, 4) = DateSerial(Year(Tablo(i - 1, 4)), Month(Tablo(i - 1, 4)) + 60 / NbPaiements, Day(Tablo(i - 1, 4)))
                Tablo(i, 5) = .Range("B12")
                Tablo(i, 6) = .Range("B14")
                Tablo(i, 7) = .Range("B16")
                Tablo(i, 8) = .Range("B18")
            Next i
        End If
    End With
        
    'Copier dans le suivi
    Set rg = Sheets("Suivi CA").Range("A65000").End(xlUp).Offset(1, 0)
    rg.Resize(NbPaiements, 8) = Tablo

End Sub

Edit : bonjour JNP ! 🙂

A+

chtico · 13 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Merci,
Fonctionne parfaitement, maintenant je fais du pas à pas pour bien comprendre la mécanique.😎

chtico · 13 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Grand Chaman,

Ta proposition fonctionne aussi parfaitement.
Maintenant j'ai l'embarras du choix.
Merci😎

chtico · 15 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour,

J'ai un souci, le code proposé par Grand Chaman fonctionne sur l'exemple donné, par contre dès que je l'utilise au sein de mon classeur en réel il me génère une Erreur 9 par rapport à un indice. Pourtant ma feuille "formulaire" est identique. Je n'arrive pas à identifier le problème.

Code:

Sub Macro1()

    Dim Tablo() As Variant
    Dim Periode As String
    Dim i As Integer
    Dim NbPaiements As Integer
    Dim rg As Range
   
    Periode = Sheets("Formulaire").Range("B12")
   
    Select Case Periode
        Case "Aucune": NbPaiements = 1
        Case "Année": NbPaiements = 5           '5 ans
        Case "Trimestre": NbPaiements = 20      '5 ans x 4 trimestres
        Case "Mois": NbPaiements = 60           '5 ans x 12 mois
    End Select
       
    ReDim Tablo(1 To NbPaiements, 1 To 10)

    With Sheets("Formulaire")
        'initialisation du tablo
        Tablo(1, 1) = .Range("B4")      'client
        Tablo(1, 2) = .Range("B6")      'produit
        Tablo(1, 3) = .Range("B8")      'montant facturé
        Tablo(1, 4) = .Range("B10")     'mois facturation
        Tablo(1, 5) = .Range("B12")     'périodicité
        Tablo(1, 6) = .Range("B14")     'statut
        Tablo(1, 7) = .Range("B16")     'montat achat sur CA HT
        Tablo(1, 8) = .Range("B18")     'mois commande achat sur CA HT
        Tablo(1, 9) = .Range("E6")     'Nb d'abt extranet
        Tablo(1, 10) = .Range("H6")     'Nb de licences
       
        If NbPaiements > 1 Then  'si plus que 1 paiement
            For i = 2 To UBound(Tablo, 1)
                Tablo(i, 1) = .Range("B4")
                Tablo(i, 2) = .Range("B6")
                Tablo(i, 3) = .Range("B8")
                Tablo(i, 4) = DateSerial(Year(Tablo(i - 1, 4)), Month(Tablo(i - 1, 4)) + 60 / NbPaiements, Day(Tablo(i - 1, 4)))
                Tablo(i, 5) = .Range("B12")
                Tablo(i, 6) = .Range("B14")
                Tablo(i, 7) = .Range("B16")
                Tablo(i, 8) = .Range("B18")
                Tablo(1, 9) = .Range("E6")
                Tablo(1, 10) = .Range("H6")
                
              Next i
        End If
    End With
       
    'Copier dans le suivi
    Set rg = Sheets("Suivi CA").Range("A65000").End(xlUp).Offset(1, 0)
    rg.Resize(NbPaiements, 8) = Tablo

End Sub

L'erreur pointe sur ReDim Tablo(1 To NbPaiements, 1 To 10)

Help

chtico · 15 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Rebonjour,

J'ai solutionné le pb en basculant sur le code de JNP.
Je n'ai pas trouvé la raison du pb (peut-être un conflit entre 2 macros sensiblement identiques sur le même classeur ?).

Salut

Grand Chaman Excel · 15 Septembre 2011

Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour chtico,
Je serais curieux de comprendre le problème. Si jamais tu peux déposer ton nouveau fichier, je pourrais regarder ça.
A+

Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

chtico

XLDnaute Nouveau

Pièces jointes

JNP

XLDnaute Barbatruc

Grand Chaman Excel

XLDnaute Impliqué

chtico

XLDnaute Nouveau

chtico

XLDnaute Nouveau

chtico

XLDnaute Nouveau

chtico

XLDnaute Nouveau

Grand Chaman Excel

XLDnaute Impliqué

Discussions similaires

Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency