Microsoft 365 CODE pour vider un formulaire en évitant les doublons

S

sgangbadjo

XLDnaute Nouveau
Bonjour à tous,

Je vous prie de bien vouloir m'aider a corriger le code suivant. Il est élaboré pour vider les données sauvegardées temporairement dans un tableau de la feuille "Sheet4" vers une base de donnée sur la feuille "Sheet5" en évitant le doublon grâce à un critère qui a été défini.

Please help
VB: 
Private Sub CommandButton3_Click()
'Export des donnees du Tableau source vers la base de donnee

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critere de verification de dublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la derniere ligne du tableau source

        Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole) 'on recherche le critère
        If Not crit Is Nothing Then MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly 'Si le critère est trouvé, on remplit les cellules
            
            For i = 1 To 70
        
            Sheet5.Cells(Derlign + i, 1) = Sheet4.Cells(1 + i, 1)
            Sheet5.Cells(Derlign + i, 2) = Sheet4.Cells(1 + i, 2)
            Sheet5.Cells(Derlign + i, 3) = Sheet4.Cells(1 + i, 3)
            Sheet5.Cells(Derlign + i, 4) = Sheet4.Cells(1 + i, 4)
            Sheet5.Cells(Derlign + i, 5) = Sheet4.Cells(1 + i, 5)
            Sheet5.Cells(Derlign + i, 6) = Sheet4.Cells(1 + i, 6)
            Sheet5.Cells(Derlign + i, 7) = Sheet4.Cells(1 + i, 7)
            Sheet5.Cells(Derlign + i, 8) = Sheet4.Cells(1 + i, 8)
            Sheet5.Cells(Derlign + i, 9) = Sheet4.Cells(1 + i, 9)
            Sheet5.Cells(Derlign + i, 10) = Sheet4.Cells(1 + i, 10)
            Sheet5.Cells(Derlign + i, 11) = Sheet4.Cells(1 + i, 11)
            Sheet5.Cells(Derlign + i, 12) = Sheet4.Cells(1 + i, 12)
            Sheet5.Cells(Derlign + i, 13) = Sheet4.Cells(1 + i, 13)
            Sheet5.Cells(Derlign + i, 14) = Sheet4.Cells(1 + i, 14)
            Sheet5.Cells(Derlign + i, 15) = Sheet4.Cells(1 + i, 15)
            Sheet5.Cells(Derlign + i, 16) = Sheet4.Cells(1 + i, 16)
            Sheet5.Cells(Derlign + i, 17) = Sheet4.Cells(1 + i, 17)
            Sheet5.Cells(Derlign + i, 18) = Sheet4.Cells(1 + i, 18)
            Sheet5.Cells(Derlign + i, 19) = Sheet4.Cells(1 + i, 19)
            Sheet5.Cells(Derlign + i, 20) = Sheet4.Cells(1 + i, 20)
            Sheet5.Cells(Derlign + i, 21) = Sheet4.Cells(1 + i, 21)
            Sheet5.Cells(Derlign + i, 22) = Sheet4.Cells(1 + i, 22)
            Sheet5.Cells(Derlign + i, 23) = Sheet4.Cells(1 + i, 23)
            Sheet5.Cells(Derlign + i, 24) = Sheet4.Cells(1 + i, 24)
            
            Next i
    
  
    
End If
Set crit = Nothing

Unload Me

End Sub
 
Solution
AtTheOne
Bonjour à Tous, bonjour @sgangbadjo,
Ce serait plus facile avec un fichier exemple épuré ...
Mais dans ton code si Crit = Nothing tu pars sur une boucle, et il suffit que la première cellule testée soit <>"" pour que tu transfères les données donc si l'une des cellules suivantes est vide, tu vois s'afficher le message mais le transfert à déjà été effectué ...
Le test pour rechercher les cellules vides doit être dans la boucle FOR ... NEXT,
Le transfert de données doit être à l'extérieur de cette boucle :

Enrichi (BBcode): 
''... Ton début du Code ...
    
    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de...
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à tous, bonsoir @sgangbadjo

Actuellement ton code recherche dans la colonne Y de la feuil5 la chaîne Feuil4!E2&"-"&Feuil4!F2
et si la chaîne est trouvée alors tu copies :
les valeurs de la plage Feuil4!A2:X71 après la dernière ligne de la feuil5 (en ADerlign+1:XDerLign+70)

Si j'ai bien compris "Os dados de supervisão para este período já foram registados", lorsque l'on trouve la chaîne cherchée il s'agit d'un doublon et il ne faut pas faire la copie.

Dans ce cas ton code deviendrait :
VB: 
Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la dernière ligne du tableau source

        Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole) 'on recherche le critère
        If Not crit Is Nothing Then
            MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly
        Else  
             Sheet5.cells(Derlign+1, 1).Resize(70, 24).value= Sheet4.cells(1, 2).Resize(70, 24).value    
        End If
Set crit = Nothing

Unload Me

End Sub

Dis-moi si j'ai bien compris ton problème
Amicalement
Alain
PS : je n'ai pas fait de test, code tapé directement dans l'éditeur XLD
 
Vote positif 0 Vote négatif
S

sgangbadjo

XLDnaute Nouveau
AtTheOne à dit:
Bonsoir à tous, bonsoir @sgangbadjo

Actuellement ton code recherche dans la colonne Y de la feuil5 la chaîne Feuil4!E2&"-"&Feuil4!F2
et si la chaîne est trouvée alors tu copies :
les valeurs de la plage Feuil4!A2:X71 après la dernière ligne de la feuil5 (en ADerlign+1:XDerLign+70)

Si j'ai bien compris "Os dados de supervisão para este período já foram registados", lorsque l'on trouve la chaîne cherchée il s'agit d'un doublon et il ne faut pas faire la copie.

Dans ce cas ton code deviendrait :
VB: 
Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la dernière ligne du tableau source

        Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole) 'on recherche le critère
        If Not crit Is Nothing Then
            MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly
        Else 
             Sheet5.cells(Derlign+1, 1).Resize(70, 24).value= Sheet4.cells(1, 2).Resize(70, 24).value   
        End If
Set crit = Nothing

Unload Me

End Sub

Dis-moi si j'ai bien compris ton problème
Amicalement
Alain
PS : je n'ai pas fait de test, code tapé directement dans l'éditeur XLD
Cliquez pour agrandir...
Bonjour @AtTheOne et merci pour la promptitude.

Le code que tu proposes est plus efficace et fonctionne bien pour l'exportation des données vers Sheet5. Mais la condition pour éviter le doublon ne marche toujours pas.

Ce que j'essaie de faire c'est d'empêcher l'utilisateur de transférer vers la Sheet5, plusieurs fois les données de supervision de la même période.

La sheet4 est lui permet d'enregistré progressivement les données de supervision de la période en cours. Une fois toutes les données enregistrées pour toutes les écoles, il utilise le bouton transfert pour les envoyé vers la sheet5. Une fois transféré, les cellules de la Sheet4 seront vidées sur le Range (E2 :X71).

J'attache le fichier pour faciliter la prise en main.
Le Userform est nommé : monitoring

Merci Alain pour l'appui
 

Pièces jointes

  • BASE DE DADOS REGIONAL.xlsm
    255.9 KB · Affichages: 5
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour à tous, bonjour @sgangbadjo

Essaie en ajoutant , LookIn:=xlValues dans le Find pour effectuer une recherche dans les valeurs et non pas dans les formules ...


Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la dernière ligne du tableau source

Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère
If Not crit Is Nothing Then​
MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly​
Else​
Sheet5.cells(Derlign+1, 1).Resize(70, 24).value= Sheet4.cells(1, 2).Resize(70, 24).value​
End If
Set crit = Nothing

Unload Me
​
End sub

Amicalement
Alain
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Bonjour à tous
la condition ne marche toujours pas
Cliquez pour agrandir...
ben.. c'est normal
une condition c'est quoi?
si ceci alors celà sinon (rien ou faire autre chause ou boire une biere

en vba on a 3 solutions avec les if simples

solution 1

VB: 
if condition vrai then
' faire ceci
'ton code transfert ici inclu dans le If 

end if

solution 2
Code: 
if not condition  vrai then exit sub
'ton code detransfert ici en dehors du If
'il ne sera bien évidement pas executé puisque l'on sort avant si condition  n'est pas remplie

solution 3
Code: 
if condition vrai  then
'code de transfert
else
msgbox "......",vbokonly:exit sub
end if

conclusion au plus simple met un exit sub après ton msgbox
Code: 
 If Not crit Is Nothing Then MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly:exit sub  'on sort si pas trouvé
 
Vote positif 0 Vote négatif
S

sgangbadjo

XLDnaute Nouveau
AtTheOne à dit:
Bonjour à tous, bonjour @sgangbadjo

Essaie en ajoutant , LookIn:=xlValues dans le Find pour effectuer une recherche dans les valeurs et non pas dans les formules ...


Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon​
Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la dernière ligne du tableau source​
​
Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère​
If Not crit Is Nothing Then​
MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly​
Else​
Sheet5.cells(Derlign+1, 1).Resize(70, 24).value= Sheet4.cells(1, 2).Resize(70, 24).value​
End If​
Set crit = Nothing​
​
Unload Me​
​
End sub

Amicalement
AtTheOne à dit:
Bonjour à tous, bonjour @sgangbadjo

Essaie en ajoutant , LookIn:=xlValues dans le Find pour effectuer une recherche dans les valeurs et non pas dans les formules ...


Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, i&
Dim veri As String
Dim crit As Range

veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon​
Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la dernière ligne du tableau source​
​
Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère​
If Not crit Is Nothing Then​
MsgBox ("Os dados de supervisão para este período já foram registados"), vbOKOnly​
Else​
Sheet5.cells(Derlign+1, 1).Resize(70, 24).value= Sheet4.cells(1, 2).Resize(70, 24).value​
End If​
Set crit = Nothing​
​
Unload Me​
​
End sub

Amicalement
Alain
Cliquez pour agrandir...
Cher @AtTheOne, Ca marche avec le LookIn:=xlValues
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
S

sgangbadjo

XLDnaute Nouveau
Bonsoir @AtTheOne, @patricktoulon et Tous

Je continue d'avoir un petit échec sur mon code de transfert de données. Le transfert doit se faire suivant deux conditions:
1) Ma variable Crit doit être égale a Nothing
2) Toutes mes cellules de ma plage Sheet4.Cells(i, 7) doivent être renseignées

Lorsque j'exécute le code, même quand les conditions ne sont pas réunies, le MsgBox apparait mais derrière cela, les données sont quand même transférées.

Je vous prie de m'assister


VB: 
Private Sub CommandButton3_Click()
'Export des données du Tableau source vers la base de donnée

Dim Derlign&, Der&, i&
Dim veri As String
Dim crit As Range

    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la dernière ligne du tableau de destination
    Der = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la derniere ligne du tableau source
        
        Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère
        For i = 2 To Der
        If Not crit Is Nothing Then
        
        MsgBox ("Os dados de supervisão para este período já foram registados "), vbOKOnly  'Message d'erreur en cas d'existence de données sur la période de rapportage dans le tableau de destination.
        Exit Sub
        Else
                        
            If Sheet4.Cells(i, 7) = "" Then    ' On vérifie que toutes les cellules de la plage (i,7) de la feuille 4 sont renseignées.
            MsgBox ("Os dados de todas as escolas não foram registados"), vbOKOnly   'Message d'erreur s'il ya des cellules non renseignées
            Exit Sub
            
            Else   'Transfert de données si les deux conditions sont remplies
        
            Sheet5.Cells(Derlign + 1, 1).Resize(70, 24).Value = Sheet4.Cells(2, 1).Resize(70, 24).Value
            Sheet4.Cells(2, 5).Resize(70, 24).Value = ""
            ListView1.ListItems.Clear
            End If
        End If
        Next i
        
        
Set crit = Nothing
 
End Sub
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour à Tous, bonjour @sgangbadjo,
Ce serait plus facile avec un fichier exemple épuré ...
Mais dans ton code si Crit = Nothing tu pars sur une boucle, et il suffit que la première cellule testée soit <>"" pour que tu transfères les données donc si l'une des cellules suivantes est vide, tu vois s'afficher le message mais le transfert à déjà été effectué ...
Le test pour rechercher les cellules vides doit être dans la boucle FOR ... NEXT,
Le transfert de données doit être à l'extérieur de cette boucle :

Enrichi (BBcode): 
''... Ton début du Code ...
    
    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la dernière ligne du tableau de destination
    Der = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la derniere ligne du tableau source
        
    Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère
    If Not crit Is Nothing Then
        'On a trouvé un doublon : On Sort
        MsgBox ("Os dados de supervisão para este período já foram registados "), vbOKOnly  'Message d'erreur en cas d'existence de données sur la période de rapportage dans le tableau de destination.
        Exit Sub
    Else
        Set Crit = Nothing
        'On n'a pas trouvé de doublon : on vérifie le 2ème critère   
        For i = 2 To Der

            If Sheet4.Cells(i, 7) = "" Then    ' On vérifie que toutes les cellules de la plage (i,7) de la feuille 4 sont renseignées.
                'On a trouvé une cellule vide : On sort
                MsgBox ("Os dados de todas as escolas não foram registados"), vbOKOnly   'Message d'erreur s'il ya des cellules non renseignées
                Exit Sub
            End if
            
        Next i
    End if
            
 'Transfert de données si les deux conditions sont remplies à l'extérieur de la boucle
''...Ta fin de Code ...

    Sheet5.Cells(Derlign + 1, 1).Resize(70, 24).Value = Sheet4.Cells(2, 1).Resize(70, 24).Value
    Sheet4.Cells(2, 5).Resize(70, 24).Value = ""
    ListView1.ListItems.Clear

Amicalement
Alain
 
Vote positif 0 Vote négatif
Solution
S

sgangbadjo

XLDnaute Nouveau
AtTheOne à dit:
Bonjour à Tous, bonjour @sgangbadjo,
Ce serait plus facile avec un fichier exemple épuré ...
Mais dans ton code si Crit = Nothing tu pars sur une boucle, et il suffit que la première cellule testée soit <>"" pour que tu transfères les données donc si l'une des cellules suivantes est vide, tu vois s'afficher le message mais le transfert à déjà été effectué ...
Le test pour rechercher les cellules vides doit être dans la boucle FOR ... NEXT,
Le transfert de données doit être à l'extérieur de cette boucle :

Enrichi (BBcode): 
''... Ton début du Code ...
   
    veri = Sheet4.Cells(2, 5) & "-" & Sheet4.Cells(2, 6) 'critère de vérification de doublon
    Derlign = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row  'Identification de la dernière ligne du tableau de destination
    Der = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row 'Identification de la derniere ligne du tableau source
       
    Set crit = Sheet5.Range("Y1:Y" & Derlign).Find(veri, lookat:=xlWhole, LookIn:=xlValues) 'on recherche le critère
    If Not crit Is Nothing Then
       'On a trouvé un doublon : On Sort
        MsgBox ("Os dados de supervisão para este período já foram registados "), vbOKOnly  'Message d'erreur en cas d'existence de données sur la période de rapportage dans le tableau de destination.
        Exit Sub
    Else
        Set Crit = Nothing
        'On n'a pas trouvé de doublon : on vérifie le 2ème critère  
        For i = 2 To Der

            If Sheet4.Cells(i, 7) = "" Then    ' On vérifie que toutes les cellules de la plage (i,7) de la feuille 4 sont renseignées.
                'On a trouvé une cellule vide : On sort
                MsgBox ("Os dados de todas as escolas não foram registados"), vbOKOnly   'Message d'erreur s'il ya des cellules non renseignées
                Exit Sub
            End if
           
        Next i
    End if
           
 'Transfert de données si les deux conditions sont remplies à l'extérieur de la boucle
''...Ta fin de Code ...

    Sheet5.Cells(Derlign + 1, 1).Resize(70, 24).Value = Sheet4.Cells(2, 1).Resize(70, 24).Value
    Sheet4.Cells(2, 5).Resize(70, 24).Value = ""
    ListView1.ListItems.Clear

Amicalement
Alain
Cliquez pour agrandir...
Merci @AtTheOne.
Ca marche et j'en sais un peu plus sur les boucles.
Bon après midi et merci pour le partage
Simplice
 
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
934
Nicolas JACQUIN
Nicolas JACQUIN
T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
487
troki74
T
R
  • Question
Microsoft 365 Supprimer les lignes vides d'une variable tableau
Réponses
1
Affichages
542
Phil69970
Phil69970
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
576
Isabellisa
I
Dadi147
  • Résolu(e)
XL 2016 cellules A, b, C et D sont automatiquement vides
Réponses
3
Affichages
536
job75
job75
M
  • Question
Microsoft 365 Programme trop lent
Réponses
12
Affichages
853
Hasco
Hasco
J
  • Question
XL 2016 Transformer un nouveau Tableau à double entrée en liste en VBA - impossibilité d'adapter le code
2
Réponses
23
Affichages
1 K
patricktoulon
patricktoulon
A
  • Résolu(e)
Microsoft 365 Trop de caractères de continuité de ligne
Réponses
9
Affichages
716
TooFatBoy
TooFatBoy
mromain
Génération de QR Codes
Réponses
1
Affichages
701
Cousinhub
Cousinhub
T
  • Question
XL 2016 Modification de données sur 2 feuilles différentes via UserForm
Réponses
14
Affichages
2 K
tontonboulii
T

Membres actuellement en ligne

15 membres et 104 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 722
Messages
2 112 194
Membres
111 462
dernier inscrit
ymd76