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

sgangbadjo · 10 Février 2022

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

AtTheOne · 10 Février 2022

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

sgangbadjo · 11 Février 2022

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

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

AtTheOne · 11 Février 2022

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

patricktoulon · 11 Février 2022

re
Bonjour à tous

la condition ne marche toujours pas

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é

AtTheOne · 11 Février 2022

Bonjour à tous bonjour @patricktoulon

Dans ma réponse, le test est correct :
Sub ...
...
If condition Then
Msgbox ...
Else
Actions si non trouvé
End If
Actions de fin communes aux deux résultats
End Sub

Ce qui ne fonctionnait pas c'est bien la recherche qui en recherchant dans les formule renvoyait toujours Nothing ...

Amicalement
Alain

patricktoulon · 11 Février 2022

Bonjour @AtTheOne
oui on s'est croisé j'ai laissé trop longtemps la page ouverte
perso un exit sub au message et c'est bouclé

sgangbadjo · 11 Février 2022

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

sgangbadjo · 11 Février 2022

Cher @AtTheOne ca marche avec LookIn:=xlValues
Merci beaucoup pour le partage de connaissance.

sgangbadjo · 22 Février 2022

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

AtTheOne · 23 Février 2022

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

sgangbadjo · 23 Février 2022

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

Merci @AtTheOne.
Ca marche et j'en sais un peu plus sur les boucles.
Bon après midi et merci pour le partage
Simplice

Effectuez une recherche sur Excel Downloads...

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

sgangbadjo

XLDnaute Nouveau

AtTheOne

AtTheOne

XLDnaute Accro

sgangbadjo

XLDnaute Nouveau

Pièces jointes

AtTheOne

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

sgangbadjo

XLDnaute Nouveau

sgangbadjo

XLDnaute Nouveau

sgangbadjo

XLDnaute Nouveau

AtTheOne

XLDnaute Accro

sgangbadjo

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée