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

Amigo

XLDnaute Occasionnel
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 :
  1. Si les valeurs existent dans 2025, afficher le message “Personne existe” et passer au tableau suivant.
  2. 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.
  3. 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
 

Pièces jointes

  • FormRechercheModifAjoutSupMultiBD - V2.xlsm
    82.3 KB · Affichages: 7
Dernière édition:

Oneida

XLDnaute Impliqué
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

XLDnaute Occasionnel
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

XLDnaute Impliqué
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

XLDnaute Occasionnel
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.
  1. Tout d’abord, supprimez l’enregistrement “Balu” du tableau 2026 et conservez-le dans les tableaux 2024 et 2025.
  2. Ensuite, choisissez le tableau 2025 et la ligne correspondant à “Balu”.
  3. 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

XLDnaute Impliqué
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)
 

Pièces jointes

  • FormRechercheModifAjoutSupMultiBD - V2_SWF.xlsm
    89 KB · Affichages: 3
Dernière édition:

Amigo

XLDnaute Occasionnel
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

XLDnaute Impliqué
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

XLDnaute Occasionnel
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
 
Dernière édition:

Oneida

XLDnaute Impliqué
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
 

Oneida

XLDnaute Impliqué
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
 

Pièces jointes

  • FormRechercheModifAjoutSupMultiBD - V2_Sc.xlsm
    157.1 KB · Affichages: 0
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 864
Messages
2 093 014
Membres
105 607
dernier inscrit
Grospsdresbois