Microsoft 365 Eviter double enregistrement

pompaero

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

Pièces jointes

  • PompaeroV0 Admin.xlsm
    927.2 KB · Affichages: 8
C

Compte Supprimé 979

Guest
Salut Pompaero,

Voici une solution ;)
VB:
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

@+
 
Dernière modification par un modérateur:

pompaero

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

pompaero

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

Pièces jointes

  • PompaeroV0 Admin.xlsm
    928.8 KB · Affichages: 2
C

Compte Supprimé 979

Guest
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
VB:
=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
2020-04-21_08h32_51.png




@+
 

pompaero

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

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi