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

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...

la condition ne marche toujours pas

Cliquez pour agrandir...

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

end if

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

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

 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 à 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...

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...