Dupliquer données via combo

cheyenne63 · 9 Mai 2016

Bonjour
En feuille «BDFT» , ma base de données (tri alphabétique sur la colonne A).
Je voudrais qu’après l’ouverture de l’USF (bouton feuille 2) et après avoir fait un choix d’une valeur dans le combo, ça duplique (via le bouton «Valider») les valeurs associées à ce choix avec en colonne A la nouvelle désignation (indiquée dans le textbox).
Deux contraintes :
- La macro ne doit pas fonctionner (message spécifique) si le textbox est vide (message spécifique)
- La macro ne doit pas fonctionner (autre message spécifique) si le textbox est égal à une valeur déjà présente dans la colonne A de « BDFT »

Pour plus de clarté, j’ai inséré un exemple dans une 3° feuille avec en jaune les nouvelles lignes insérées après duplication de « Désignation 4 »

Merci d’avance et bonne journée

thebenoit59 · 6 Juin 2016

Re : Dupliquer données via combo

Il est, parfois, plus pratique de décomposer les procédures en sous-procédures.

GADENSEB · 6 Juin 2016

Re : Dupliquer données via combo

c'est clair, je vais appliquer cette méthode dans le futur !!

GADENSEB · 8 Juin 2016

Re : Dupliquer données via combo

Hello
ton code marche au poil
est-ce que l'on pourrait lui faire inclure le mois en colonne D (Onglet COMPTES) :
JANVIER FEVRIER MARS ......

je me rend compte que ce n'est pas optimum dans mon code :
cela marche trés bien pour une saisie simple mais avec ton code, le mois reste le mm et n'est pas incrémenté au fur et à mesure

Pour info, pour calculer l'année je me sers de

Code:

 'Transformation des Dates en Année
    .Range("C2:C" & .Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
        "=YEAR(RC2)"

C'est jouable tu crois ?

Merci bonne journée

Seb

thebenoit59 · 8 Juin 2016

Re : Dupliquer données via combo

C'est jouable.
A la fin du code, tu as une boucle pour modifier le numéro en colonne A.
On peut également ajouter la modification du mois en colonne D.

Code:

                For i = LastLigne + 2 To LastLigne + NbRecursivite.Text * 2 + 1
                    .Cells(i, 1).Value = .Cells(i - 1, 1).Value + 1
                    .Cells(i, 4).Value = UCase(Format(.Cells(i, 2).Value, "mmmm"))
                Next i

GADENSEB · 8 Juin 2016

Re : Dupliquer données via combo

Hello
Parfait pour ce bout de code !!

Par contre, je m'apercoie que l’incrémentation des Electricité 06/2016 puis Electricité 07/2016 ....... avec ce nouveau code

Pourrait-on le réinclure?
Merki

Bonne journée

thebenoit59 · 8 Juin 2016

Re : Dupliquer données via combo

Il doit manquer une partie de ta phrase je pense

.
Je n'ai pas touché au reste du code, donc je ne vois pas ce qui a pu changer.

GADENSEB · 8 Juin 2016

Re : Dupliquer données via combo

Ben on est bien dac que le dernier code a jour c'est

Code:

Private Sub Bt_Validation_Click()

'Déclaration des variables
Dim LastLigne As Integer

'On désactive les applications
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'Texte PopUp
TexteDate = "En date du : " & DATESAISIE
Textecompte = "Sur le Compte : " & COMPTE
TexteBR = "En : " & BUDGETREEL
TexteDépenses = "Pour la dépense : " & LIBELLE

If DEBIT <> "" Then
    TexteMtt = "Pour un montant de : " & DEBIT & " €"
    Else: TexteMtt = "Pour un montant de : " & CREDIT & " €"
End If

TextePopUp = Chr(10) & TexteDate & Chr(10) & Textecompte & Chr(10) & TexteBR & Chr(10) & TexteDépenses & Chr(10) & TexteMtt

If MsgBox("Ajouter une nouvelle Ligne ? " & Chr(10) & TextePopUp, vbYesNo, "Demande de confirmation d'ajout.") = vbYes Then Ajout

'Réactivation des applications
With Application
    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With

'On décharge l'userform
Unload Me

End Sub

Code:

Private Sub Ajout()
    'On détermine la dernière ligne de la feuille "COMPTES"
    Set f = Sheets("COMPTES")
    LastLigne = f.Range("a65536").End(xlUp).Row + 1
    
    'On inscrit les valeurs dans la feuille COMPTES
    With f.Cells(LastLigne, 1)
        .Offset(, 0).Value = CDbl(Me.CODE.Text)
        .Offset(, 1).Value = CDate(Me.DATESAISIE)
        .Offset(, 3).Value = Me.MOIS
        .Offset(, 4).Value = Me.BUDGETREEL
        .Offset(, 5).Value = Me.COMPTE
        .Offset(, 6).Value = Me.POSTE
        .Offset(, 9).Value = Me.NUMERO
        .Offset(, 10).Value = Me.LIBELLE
        .Offset(, 11).Value = Me.MODERGT
        .Offset(, 14).Value = Me.BQ
        If Me.DEBIT.Text <> "" Then .Offset(, 15).Value = CCur(Me.DEBIT)
        If Me.CREDIT.Text <> "" Then .Offset(, 16).Value = CCur(Me.CREDIT)
    End With
    
    'On duplique la ligne si la checkbox double est validée
    With f
        If CB_Double.Value = True Then
            .Rows(LastLigne).Copy .Cells(LastLigne + 1, 1)
            .Cells(LastLigne + 1, 1).Value = .Cells(LastLigne + 1, 1) + 1
            .Cells(LastLigne + 1, 5).Value = "REEL"
    
        'On duplique les valeurs si la checkbox récursivité est validée
            If CB_Recursivite.Value = True Then
                .Rows(LastLigne & ":" & LastLigne + 1).Copy .Rows(LastLigne + 2).Resize(NbRecursivite.Text * 2)
        
            'On boucle les nouvelles valeurs copiées
                j = 1
                For i = LastLigne + 2 To LastLigne + NbRecursivite.Text * 2 Step 2
                    'On modifie la date selon le critère de la combobox
                    If Me.MULTIPLES.Text = "ANS" Then
                        .Cells(i, 2).Resize(2).Value = DateAdd("yyyy", 1, CDate(.Cells(i - 1, 2).Value))
                        Else: .Cells(i, 2).Resize(2).Value = DateAdd("m", 1, CDate(.Cells(i - 1, 2).Value))
                    End If
                    'On modifie le texte du poste
                    If .Cells(i, 11).Value Like "*|*" Then
                        .Cells(i, 11).Resize(2).Value = Left(.Cells(i, 11).Value, InStr(.Cells(i, 11).Value, "|")) & " " & Format(.Cells(i, 2).Value, "mm/yyyy")
                    End If
                    'On boucle
                j = j + 1
                Next i
                
                For i = LastLigne + 2 To LastLigne + NbRecursivite.Text * 2 + 1
                    .Cells(i, 1).Value = .Cells(i - 1, 1).Value + 1
                    .Cells(i, 4).Value = UCase(Format(.Cells(i, 2).Value, "mmmm"))
                Next i
            End If
        End If
    End With
    
End Sub

et ca veut pas ... sniff

thebenoit59 · 8 Juin 2016

Re : Dupliquer données via combo

Oui mais ça ne veut pas quoi ?

GADENSEB · 8 Juin 2016

Re : Dupliquer données via combo

faire l’incrémentation des Electricité 06/2016 puis Electricité 07/2016 .......

thebenoit59 · 8 Juin 2016

Re : Dupliquer données via combo

thebenoit59 à dit:
Bonjour Seb.

Je me suis permis de modifier l'écriture du Libellé, en y ajoutant le caractère suivant : "|"
Cela sera plus simple pour modifier l'écriture avec la récursivité.

Si tu n'as pas ce caractère l'incrémentation ne se fera pas

GADENSEB · 8 Juin 2016

Re : Dupliquer données via combo

Okiiiiiii
Je n'avais pas compris !!!
j'ai bougé d'autres parties de mon code pour tjrs avoir "|" et effectivement cela fonctionne

Thanks à toi

Bonne journée

GADENSEB · 22 Juin 2016

Re : Dupliquer données via combo

hello
me revoila sur mon fameux code
Encore une fois ton code est génial

Code:

Private Sub Ajout()
    'On détermine la dernière ligne de la feuille "COMPTES"
    Set f = Sheets("COMPTES")
    LastLigne = f.Range("a65536").End(xlUp).Row + 1
    
    'On inscrit les valeurs dans la feuille COMPTES
    With f.Cells(LastLigne, 1)
        .Offset(, 0).Value = CDbl(Me.CODE.Text)
        .Offset(, 1).Value = CDate(Me.DATESAISIE)
        .Offset(, 3).Value = Me.MOIS
        .Offset(, 4).Value = Me.BUDGETREEL
        .Offset(, 5).Value = Me.COMPTE
        .Offset(, 6).Value = Me.POSTE
        .Offset(, 9).Value = Me.NUMERO
        .Offset(, 10).Value = Me.LIBELLE
        .Offset(, 11).Value = Me.MODERGT
        .Offset(, 14).Value = Me.BQ
        If Me.DEBIT.Text <> "" Then .Offset(, 15).Value = CCur(Me.DEBIT)
        If Me.CREDIT.Text <> "" Then .Offset(, 16).Value = CCur(Me.CREDIT)
    End With
    
    'On duplique la ligne si la checkbox double est validée
    With f
        If CB_Double.Value = True Then
            .Rows(LastLigne).Copy .Cells(LastLigne + 1, 1)
            .Cells(LastLigne + 1, 1).Value = .Cells(LastLigne + 1, 1) + 1
            .Cells(LastLigne + 1, 5).Value = "REEL"
    
   
    
        'On duplique les valeurs si la checkbox récursivité est validée
            If CB_Recursivite.Value = True Then
                .Rows(LastLigne & ":" & LastLigne + 1).Copy .Rows(LastLigne + 2).Resize(NbRecursivite.Text * 2)
        
            'On boucle les nouvelles valeurs copiées
                j = 1
                For i = LastLigne + 2 To LastLigne + NbRecursivite.Text * 2 Step 2
                    'On modifie la date selon le critère de la combobox
                    If Me.MULTIPLES.Text = "ANS" Then
                        .Cells(i, 2).Resize(2).Value = DateAdd("yyyy", 1, CDate(.Cells(i - 1, 2).Value))
                        Else: .Cells(i, 2).Resize(2).Value = DateAdd("m", 1, CDate(.Cells(i - 1, 2).Value))
                    End If
                    'On modifie le texte du poste
                    If .Cells(i, 11).Value Like "*|*" Then
                        .Cells(i, 11).Resize(2).Value = Left(.Cells(i, 11).Value, InStr(.Cells(i, 11).Value, "|")) & " " & Format(.Cells(i, 2).Value, "mm/yyyy")
                    End If
                    'On boucle
                j = j + 1
                Next i
                
                For i = LastLigne + 2 To LastLigne + NbRecursivite.Text * 2 + 1
                    .Cells(i, 1).Value = .Cells(i - 1, 1).Value + 1
                    .Cells(i, 4).Value = UCase(Format(.Cells(i, 2).Value, "mmmm"))
                Next i
            End If
        End If
    End With
    
End Sub

Et là je voudrais rajouté un niveau de complexité

dans mon usf (comme pour CB_Double) j'ai rajouté un CB_Vrtinterne (true ou false) et un combobox VrtInterne (liste de la plage nommée Tb_P_Comptes)
cela me permettrai de faire des virements de compte à compte

Je m'explique
Je saisie une ligne dans COURANT mais en mm temps je veux qu'elle soit aussi saisie dans le compte qui sera inscrit dans le combobox VrtInterne
Soit

Code:

.Cells(LastLigne + 1, 4).Value = VrtInterne.value

mais la subtilité c'est (comme c'est un virement entre compte) si dans la premiére saisie la somme est au débit..... fatalement avec la CB_Vrtinterne cela voudra dire que l'autre écriture sera au crédit. et inversement ....

Et les trois options :
- Double : CB_Double
- Récursivité : CB_Recursivite
- Virement Interne : CB_Vrtinterne

Pouvant fonctionner indépendamment, ou en association 2 d'entre elles ou les 3 ensembles.

tu fais déjà fonctionner :
- Double : CB_Double
- Récursivité : CB_Recursivite
et là j'avoue que je vois pas comment ..... j'ai beau avoir relu le code je ne vois pas quand tu fais appel à CB_double quand CB_Recursivite s'exécute.
Ou alors c'est au moment de compter les lignes créent avec copy.row +....

C'est ça non ? Tu fais une CB_Recursivite à chaque copie de ligne CB_double

Donc si je résume :
- Changement de compte si CB_Vrtinterne is true

Code:

 If CB_Vrtinterne.Value = True Then
            .Rows(LastLigne).Copy .Cells(LastLigne + 1, 1)
            .Cells(LastLigne + 1, 1).Value = .Cells(LastLigne + 1, 1) + 1
            .Cells(LastLigne + 1, 4).Value = VrtInterne.value
            ..... inverser DEBIT / CREDIT

Puis le reste du code précédent

C'est ça, non ? Mon raisonnement est logique ?

Nb: j'ai pas mon fichier test sous le coude, je fais le texte depuis mon téléphone

À+ seb

GADENSEB · 24 Juin 2016

Re : Dupliquer données via combo

Hello
J'ai bredouillé ce code, mais j'ai pas trop confiance ....
qu'est ce que tu en penses?

Code:

If CB_Vrtinterne.Value = True Then
            .Rows(LastLigne).Copy .Cells(LastLigne + 1, 1)
            .Cells(LastLigne + 1, 1).Value = .Cells(LastLigne + 1, 1) + 1
            .Cells(LastLigne + 1, 4).Value = me.VrtInterne
          '  ..... inverser DEBIT / CREDIT
if DEBIT <> ""
'DEBIT supérieur à 0 on tranfert la  valeur dans CREDIT
.Cells(LastLigne + 1, 18).Value = me.DEBIT
'on  vide DEBIT
me.DEBIT =""
ELSE
'CREDIT supérieur à 0 on tranfert la  valeur dans DEBIT
.Cells(LastLigne + 1, 17).Value = me.CREDIT
'on  vide CREDIT
me.CREDIT =""
end if
end if

Bonne am
SEb

thebenoit59 · 27 Juin 2016

Re : Dupliquer données via combo

GADENSEB à dit:

Hello
J'ai bredouillé ce code, mais j'ai pas trop confiance ....
qu'est ce que tu en penses?

Code:

If CB_Vrtinterne.Value = True Then
            .Rows(LastLigne).Copy .Cells(LastLigne + 1, 1)
            .Cells(LastLigne + 1, 1).Value = .Cells(LastLigne + 1, 1) + 1
            .Cells(LastLigne + 1, 4).Value = me.VrtInterne
          '  ..... inverser DEBIT / CREDIT
if DEBIT <> ""
'DEBIT supérieur à 0 on tranfert la  valeur dans CREDIT
.Cells(LastLigne + 1, 18).Value = me.DEBIT
'on  vide DEBIT
me.DEBIT =""
ELSE
'CREDIT supérieur à 0 on tranfert la  valeur dans DEBIT
.Cells(LastLigne + 1, 17).Value = me.CREDIT
'on  vide CREDIT
me.CREDIT =""
end if
end if

Bonne am
SEb

Bonjour Seb.

Je n'ai pas pris le temps de me pencher sur ton ajout.
A force d'ajouter des options, je commence à me perdre dans ton fichier

.
Je regarde ça quand je pourrai me poser tranquillement dessus et pouvoir analyser toutes tes procédures pour mieux cerner l'entièreté du fichier

GADENSEB · 27 Juin 2016

Re : Dupliquer données via combo

Hello

Pas de soucis.

le fichier à té construit au fil du temps.
effectivement les procédures s'empilent et se croisent, ce qui peut alourdir le fichier et le temps déxecution .... LOL
Je suis là en cas de questions

Merci
Bonne journée
Seb

Effectuez une recherche sur Excel Downloads...

Dupliquer données via combo

cheyenne63

XLDnaute Occasionnel

Pièces jointes

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

GADENSEB

XLDnaute Impliqué

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

GADENSEB

XLDnaute Impliqué

GADENSEB

XLDnaute Impliqué

thebenoit59

XLDnaute Accro

GADENSEB

XLDnaute Impliqué

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums