Microsoft 365 Eviter double enregistrement

[pompaero]

Bonjour le forum,

Je viens chercher un peu d'aide.
Dans le fichier joint, j'aimerai un complément de macro afin d'éviter un doublon d'enregistrement.
Ce fichier est un modele et allégé par rapport mon original.
Le but est dans l'onglet "Mvt carbu" bouton (Valider) avoir en début de code un complément de macro évitant d'enregistrer en double au moins sur les colonnes B, C, F, H, I, J (et pouvoir ajouter d'autres colonne si besoin).
Est ce possible ?
Merci par avance de votre soutien.

pompaero

 

[Compte Supprimé 979]

Salut Pompaero,

Voici une solution 😉

Private Sub CBcarbu_Click()
  Dim dlt As Long, L As Long
  Dim Ind As Integer, TabCel() As String
  Dim Sht As Worksheet
  ' Définir la feuille de travail
  Set Sht = ThisWorkbook.Sheets("Mvt Carbu")
  '
  If Sht.Range("F7") < Sht.Range("H7") Then
    MsgBox ("Compteur incorrect !!!")
    Sht.Range("F7") = "": Sht.Range("F7").Select
    Exit Sub
  End If
  ' controle si il y a toutes les informations
  TabCel = Split("D4,D5,F4,F6,F7,H4", ",")
  For Ind = 0 To UBound(TabCel)
    If Sht.Range(TabCel(Ind)).Value = "" Then
      MsgBox "il manque l'information en : " & TabCel(Ind), vbCritical, "OUPS..."
      Sht.Range(TabCel(Ind)).Select
      Exit Sub
    End If
  Next Ind
  ' Vérifier si c'est un doublon
  dlt = Sht.Range("B" & Rows.Count).End(xlUp).Row
  For L = 11 To dlt
    ' Si la date correspond
    If DateValue(Sht.Range("B" & L)) = DateValue(Sht.Range("D4")) Then
      ' Si le véhicule correspond
      If Sht.Range("C" & L) = Sht.Range("D5") Then
        ' Si le conducteur correspond
        If Sht.Range("F" & L) = Sht.Range("F4") Then
          ' Si le compteur correspond
          If Sht.Range("I" & L) = Sht.Range("F7") Then
            ' Si le litrage correspond
            If Sht.Range("J" & L) = Sht.Range("H4") Then
              ' Alors il s'agit d'un doublon
              MsgBox "Ces données ont déjà été enregistrées !", vbCritical, "OUPS..."
              Exit Sub
            End If
          End If
        End If
      End If
    End If
  Next L
  ' Tout est ok, demander
  If MsgBox("Vous allez effectuer l'enregistrement de " & Sht.Range("H4").Value & " Litres de " & Sht.Range("D7"), vbYesNo) = vbNo Then
    Exit Sub
  End If
  ' Réponse oui
  'Connection enregistrer dans histo
  With Sheets("Histo")
    L = .Range("A" & Rows.Count).End(xlUp).Row + 1  'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
    .Range("A" & L).Value = Now
    '   .Range("B" & L).Value = Sheets("Accueil").Range("D12")
    '   .Range("C" & L).Value = Sheets("Accueil").Range("E12")
    .Range("D" & L).Value = "Mvt carburant " & Sht.Range("F6") & " (" & Sht.Range("H4") & "Lt)"
    L = L + 1
  End With
           
  If Sht.Range("B11") <> "" Then
    Sht.ListObjects(1).ListRows.Add.Range(1, 1).Value = CDate(Range("D4").Value)    'Now()
  Else
    Sht.Range("B11") = CDate(Range("D4").Value)    'Now()
  End If
  'ajouter les informations dans le tableau
  dlt = Sht.Range("B" & Rows.Count).End(xlUp).Row
  Sht.Range("B" & dlt) = Format(Range("D4"), "dd/mm/yyyy")
  Sht.Range("B" & dlt).NumberFormat = "dd/mm/yyyy"
  Sht.Range("C" & dlt) = Range("D5")
  Sht.Range("D" & dlt) = Range("D6")
  Sht.Range("E" & dlt) = Range("D7")
  Sht.Range("F" & dlt) = Range("F4")
  Sht.Range("G" & dlt) = Range("F5")
  Sht.Range("H" & dlt) = Range("F6")
  Sht.Range("I" & dlt) = Range("F7")
  Sht.Range("J" & dlt) = Range("H4")
  Sht.Range("K" & dlt) = Range("H5")
  'préparation pour une nouvelle entrée
  Reset
  ActiveWorkbook.Save    'enregistrement fichier
  ' Effacer les variables objet
  Set Sht = Nothing
End Sub

@+

 

[pompaero]

Bonjour BrunoM45

Merci de ta venue aussi rapide.
J'en attendais pas autant, c'est cool de ta part.
Je viens de tester, malheureusement un bug se produit sur le mot "Stop", au début de la vérification des doublons et ne voyant pas la correspondance de ce mot, je doute un peu.
Je quitte pour ce soir, a bientôt.
Merci
@+

 

[Compte Supprimé 979]

Re,

Désolé, c'était pour mon test, il faut bien entendu supprimer cette ligne

    If L = 25 Then Stop

Et ce n'est pas un bug, mais un arrêt du code 😉

 

[pompaero]

Bonjour BrunoM45

C'est pas bien de faire au petit manipulateur d'excel 😉🙂
Ok, merci, je viens de tester, c'est parfait cela fonctionne.

A bientôt
pompaero

 

[pompaero]

Bonjour,

De retour, un petit soucis sur l'avancement de mon projet dans la macro , partie éviter les doublons.
Dans un autre onglet, il y a sur 2 colonnes les mêmes cellules qui s'enregistre soit dans l'une ou l'autre par rapport un mot (suivi stock). J'arrive à faire l'enregistrement avec ce code

  If Sht.Range("E4") = "Entrée" Then
    Sht.Range("F" & dlt) = Range("E5")
  Else
    Sht.Range("G" & dlt) = Range("E5")
  End If

et aimerai la même idée dans la partie vérification doublon. que je n'arrive pas à mettre en place.
Vérifier si la donnée concernée est présentes soit dans la colonne F ou G.
Je ne sais pas si je suis assez claire, sinon demandez.
Merci

 

[pompaero]

C'est pas faisable peut-être ?

 

[Compte Supprimé 979]

Bonjour Pompaero

Beaucoup de choses sont faisable avec Excel, les formules et/ou le VBA

Sinon, par rapport au code déjà donné, voici une autre possibilité par formule plutôt que par VBA
En I4, tu mets la formule

=SI(E4="Entrée";NB.SI.ENS(TbMvtEmulseur[Date];C4;TbMvtEmulseur[Nom];C5;TbMvtEmulseur[Lieu];C6;TbMvtEmulseur[Produit];C7;TbMvtEmulseur[Entrée];E5);NB.SI.ENS(TbMvtEmulseur[Date];C4;TbMvtEmulseur[Nom];C5;TbMvtEmulseur[Lieu];C6;TbMvtEmulseur[Produit];C7;TbMvtEmulseur[Sortie];E5))

Ensuite en E5, tu crées une donnée de validation grâce à une personnalisation
Pour pouvoir saisir une valeur, il faut que I4 soit égal à 0, sinon c'est un doublon

@+

 

[pompaero]

Bonjour BrunoM45

J'en doute pas qu'avec excel plein de chose sont faisable, c'est justement mon souci, je ne l'ai connais pas.. lol.
Je regarde ta proposition, puis reviens.

@+

 

[pompaero]

Quelle technique, fallait la connaitre celle-ci.
Du coup, pour l'alerte en cas de doublon au niveau du bouton Valider, il suffit de mettre un If (si I4 = 1 alors doublon) au lieu du code déjà donné ?
Même si un message est créé avec cette dernière procédure.

pompaero