XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier

Amigo · 7 Juin 2024

Bonjour le Forum
J’utilise un fichier contenant plusieurs tableaux. Mon souhait est de dupliquer une ligne d’un tableau dans d’autres tableaux. Ces tableaux seront sélectionnés à l’aide de cases à cocher dans un Userform qui s’ouvre lorsque l’on clique sur le bouton “Dupliquer” (voir fichier ci-joint).
Si je souhaite copier une ligne du tableau_2024 dans les tableaux 2025 et 2026 :

Si les valeurs existent dans 2025, afficher le message “Personne existe” et passer au tableau suivant.
Si les valeurs existent dans le tableau 2025 mais pas dans le tableau 2026, afficher le message “Personne existe” et copier la ligne dans 2026.
Si les valeurs n’existent ni dans 2025 ni dans 2026, copier la ligne dans les tableaux sélectionnés."

Merci par avance
Amigo

VB:

Private Sub CommandButton1_Click()
Dim mnom As String, mprenom As String
  If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
    For i = 0 To Me.Source.ListCount - 1
        If Me.Source.Selected(i) = True Then
            NomTableau = "Tableau" & Me.Source.List(i)
            On Error Resume Next
            mnom = Range(NomTableau & "[Nom]").Find(Me.TextBox1, LookIn:=xlValues)
            mprenom = Range(NomTableau & "[Prénom]").Find(Me.TextBox2, LookIn:=xlValues)
                If Trim(UCase(mnom)) = Trim(UCase(Me.TextBox1)) And Trim(UCase(mprenom)) = Trim(UCase(Me.TextBox2)) Then
                    MsgBox MsgBox(Me.TextBox2 & " " & Me.TextBox1 & " existe déjà dans " & NomTableau & vbCr & "Répéter Dupliquer")
'                    Unload Me
'                    Exit Sub
 
                Else

                    NomTableau = "Tableau" & Me.Source.List(i) 'temp
                    NbCol = Range(NomTableau).Columns.Count
                    If RechIntuit.TextBox1 <> "" Then
                        RechIntuit.Enreg = Range(NomTableau).Rows.Count + 1
                        Mode = "Consult"
                           For c = 1 To NbCol
                            If Not Range(NomTableau).Item(RechIntuit.Enreg, c).HasFormula Then
                              tmp = RechIntuit("textbox" & c)
                              If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
                                 tmp = Replace(tmp, ".", ",")
                                 Range(NomTableau).Item(RechIntuit.Enreg, c) = CDbl(tmp)
                              Else
                                  If IsDate(tmp) Then
                                    Range(NomTableau).Item(RechIntuit.Enreg, c) = CDate(tmp)
                                  Else
                                    Range(NomTableau).Item(RechIntuit.Enreg, c) = tmp
                                  End If
                              End If
                             Else
                              Range(NomTableau).Item(RechIntuit.Enreg - 1, c).Copy
                              Range(NomTableau).Item(RechIntuit.Enreg, c).PasteSpecial Paste:=xlPasteFormats
                           End If
                         Next c
                           Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), Header:=xlYes, Order1:=xlAscending
                 
                    End If

                End If
        End If
     Next i
  End If
Unload Me
End Sub

Oneida · 9 Juin 2024

Tout a fait Thierry, mais y a pas le tableau que vous avez choisi dans l'UF RechIntuit pour vos manips pour recuperer les donnees
Je suppose(itoire) que le choix se fait par un click sur une ligne de la listbox RechIntuit sinon j'espere que vous avez la memoire de 10 elephants

Amigo · 9 Juin 2024

Oneida à dit:
Tout a fait Thierry, mais y a pas le tableau que vous avez choisi dans l'UF RechIntuit pour vos manips pour recuperer les donnees
Je suppose(itoire) que le choix se fait par un click sur une ligne de la listbox RechIntuit sinon j'espere que vous avez la memoire de 10 elephants

Re
effectivement je recherche d'abord le nom puis je le selectionne dans la listbox
Cordialement

Oneida · 9 Juin 2024

Bien,
Je regarde la chose
Nous sommes d'accord qu'il n'y a que les tableaux selectionnes dans l'Userform1 a mettre a jour?

Oneida · 9 Juin 2024

Re,

Votre code s'execute sans probleme a partir du moment ou un nom et prenom sont presents dans les txtbox 1 et 2 RechIntuit.
Comprends pas ce que vous avez comme probleme pour ce cas
Par contre en cas de modif d'une ligne d'un tableau, il faut dupliquer et ensuite supprimer l'enregistrement dans les autres tableaux selectionner en Userform1 a condition de s'en rappeler

Amigo · 9 Juin 2024

Oneida à dit:
Re,

Votre code s'execute sans probleme a partir du moment ou un nom et prenom sont presents dans les txtbox 1 et 2 RechIntuit.
Comprends pas ce que vous avez comme probleme pour ce cas
Par contre en cas de modif d'une ligne d'un tableau, il faut dupliquer et ensuite supprimer l'enregistrement dans les autres tableaux selectionner en Userform1 a condition de s'en rappeler

Re Oneida et le forum
Faites un essai.

Tout d’abord, supprimez l’enregistrement “Balu” du tableau 2026 et conservez-le dans les tableaux 2024 et 2025.
Ensuite, choisissez le tableau 2025 et la ligne correspondant à “Balu”.
Dupliquez cette ligne dans les tableaux 2024 et 2026.

Le code indiquera que Balu existe dans 2024, ce qui est vrai, mais il indiquera également qu’il existe dans 2026, ce qui est faux, et il ne l’écrira pas dans ce dernier tableau.
Cordialement

Oneida · 10 Juin 2024

Bonjour,
3. Comment voulez vous dupliquer une ligne qui n'existe plus!

Je viens de faire l'essai et en effet probleme.
Vous auriez donne cette exemple, j'aurai fait les modif plus tot vu que le fait d'ajout ne pose aucun probleme
Je regarde la chose mais pas ce matin

Suite:
J'ai ajoute une colonne en fin des tableaux pour avoir Nom et Prenom pour faire la recherche vu qu'il y aura des noms identiques et prenom different
Fait un peu a l'arrache pour colonne ajoutee et le code pour remplir la cellule de la colonne

Procedures modifiees:
RechIntuit Private Sub B_valid_Click()
Userform1 Private Sub CommandButton1_Click()
Ajoute une subroutine pour ajout ligne Sub Ajout_Ligne(NomTableau)

Amigo · 10 Juin 2024

Bonsoir Oneida et le Forum
Merci pour votre réponse.
Je testerai le fichier et ne manquerai pas de revenir vers vous.
Cordialement

Amigo · 15 Juin 2024

Bonjour Oneida et le Forum
D’abord, je m’excuse de répondre un peu tard. La semaine était trop chargée.
Le fichier semble bien fonctionner.
Merci beaucoup.
Cependant, par curiosité, j’aimerais comprendre pourquoi mon code ne fonctionne pas.
Bon week-end !
Cordialement.

Oneida · 16 Juin 2024

Bonjour,
Mettez le

VB:

On Error Resume Next

en commentaire pour voir l'erreur si le Find nom n'est pas dans la colonne Nom du tableau de recherche

j'ai simplifie et reorganise le code pour la rechecher en utilisant Application.Countif pour savoir si le nom_pernom existe ou pas dans la colonne nom_prenom que j'ai ajoute dans chaque tableau et palier au nom identique et prenom different

la majorite des personne utilisent ceci pour les recherches

Code:

Dim mnom As Range
            Set mnom = Range(NomTableau & "[Nom]").Find(Me.TextBox1, LookIn:=xlValues)
            If mnom Is Nothing Then
                MsgBox "Nok: " & NomTableau
            Else
                MsgBox "ok: " & NomTableau
            End If

Perso

Code:

Application.Countif

permet d'avoir plusieurs reponses: 0 ou un certain nombre de presence
0: existe pas
X presences: si 1 ok present, si X >1 doublon

Amigo · 16 Juin 2024

Bonjour Oneida et le Forum
Bonne fête des pères à tous les papas
Merci beaucoup pour votre aide et les explications.
Une dernière question : est-il possible de passer par une colonne virtuelle au lieu de la créer dans chaque tableau ?
Cordialement

Oneida · 17 Juin 2024

Bonjour,

Oui, mais ca revient a faire la recherche avec un nom et regarder si le prenom est le meme que celui de la ligne selectionnee dans l'userform Userform1 via userform1
Si votre fichier Excel est fait en Access, les tableau seraient des tables avec soit un champ Nom_Prenom ou un champ avec un numero Auto unique pour une recherche plus simple
Pour les tableaux Excel il est aussi interessant de faire de meme
Donc ceci explique cela
Maintenant si vous voulez je peux vous faire le code sans colonne supplementaire

Amigo · 17 Juin 2024

Bonsoir Oneida et le forum
Merci beaucoup pour ces explications.
Je ne voudrais pas abuser de votre gentillesse, sauf si cela ne vous dérange pas.
Cordialement

Oneida · 18 Juin 2024

Bonjour,
Y a pas d'lezard, je vous fais ca sans colonne sup
Combien de lignes max dans les BD?

En attendant, une facon de faire

Amigo · 18 Juin 2024

Bonsoir Oneida et le forum
Chaque BD comporte actuellement entre 5000 et 15000 lignes.
Merci pour le fichier. Je vais l’analyser en détail pour comprendre la méthode.
Cordialement

Amigo · 21 Juin 2024

Bonjour Oneida et le Forum
Merci de votre fichier qui fonctionne très bien (juste un peu lent à l’exécution avec mes BDs qui sont grandes en taille) et un grand merci pour votre implication.
J’ai aussi de mon côté continué à chercher une solution et j’en ai trouvé une que je souhaite partager avec vous et elle me semble plus rapide. ( voir code ci-après).
Encore Merci à vous et merci à ce forum d'entraide, de partage et de transmission.
Cordialement

VB:

Private Sub CommandButton1_Click()
Dim n As String, p As String, ligne As Integer
n = Me.TextBox1
p = Me.TextBox2
  If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
    For i = 0 To Me.Source.ListCount - 1
        If Me.Source.Selected(i) = True Then
            NomTableau = "Tableau" & Me.Source.List(i)
            Set mondico = CreateObject("scripting.dictionary")
            a = Range(NomTableau).Value
                lg = Range(NomTableau).Rows.Count
                For j = 1 To lg
                  mondico(a(j, 1)) = j
                Next j
                On Error Resume Next
                clé = n
                ligne = mondico(clé)
                val1 = a(ligne, 1)
                val2 = a(ligne, 2)
                   
                    Select Case ligne
                        Case Is > 0
                                If (va11 = n And val2 = p) Then
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " existe déjà dans " & NomTableau)
                                Else
                                reg = lg + 1
                                Range(NomTableau).Item(reg, 1) = Trim(UCase(CStr(Me.TextBox1)))
                                Range(NomTableau).Item(reg, 2) = Trim(Application.Proper(CStr(Me.TextBox2)))
                                Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), key2:=Range(NomTableau & "[Prénom]"), Header:=xlYes, Order1:=xlAscending
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " a été créé dans " & NomTableau)
                                End If
                        Case Is = 0
                                reg = lg + 1
                                Range(NomTableau).Item(reg, 1) = Trim(UCase(CStr(Me.TextBox1)))
                                Range(NomTableau).Item(reg, 2) = Trim(Application.Proper(CStr(Me.TextBox2)))
                                Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), key2:=Range(NomTableau & "[Prénom]"), Header:=xlYes, Order1:=xlAscending
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " a été créé dans " & NomTableau)
                    End Select

        End If
     Next i
  End If

Unload Me
End Sub

XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier

Amigo

XLDnaute Occasionnel

Pièces jointes

Oneida

XLDnaute Impliqué

Amigo

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

Oneida

XLDnaute Impliqué

Amigo

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

Pièces jointes

Amigo

XLDnaute Occasionnel

Amigo

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

Amigo

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

Amigo

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

Pièces jointes

Amigo

XLDnaute Occasionnel

Amigo

XLDnaute Occasionnel

Discussions similaires