RECHERCHE DES DOUBLONS

bonjour,

une façon rapide de le faire, en quelques minutes, sans vba:

• rassembler toutes les données dans une seule feuille
• trier sur le numéro de facture
• dans une colonne vide, ajouter une formule qui retourne 1 si la facture a le même numéro que  la ligne suivante, sinon 0
• figer la valeur dans cette colonne, remplacer la formule par la valeur
• trier sur cette nouvelle colonne

Bonjour

oui mais je cherche s'il ya encore autre astus parce-que j'ai plus que

12 feuilles dans le classeur a part feuille de saisie la ou je fait le transfert

voila le code de transfert une ligne vers la feuille qui convient je veux ajouter le

contrôle sur le N°

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim li As Long, co As Long, st As String, s As String
li = Target.Row
co = Target.Column
If Target.Value = "" Then GoTo fin
If li < lidebFJ Then GoTo fin
If Not Intersect(Target, Columns(coclic)) Is Nothing Then
  s = Target.Value
  If s = txtS Then MsgBox "ligne déjà traitée ": GoTo fin
  st = Cells(li, codatFJ + 2).Value
  If st = "" Then GoTo fin
  Call valider(st, li)
  Sheets(FJ).Cells(li, co).Value = txtS
  Sheets(FJ).Cells(li, co).Interior.ColorIndex = rouge
End If
fin:
Sheets(FJ).Select
Sheets(FJ).Cells(li + 1, co).Select
End Sub

est ce qu'il ya une idée de faire le contrôle sur N° pour

éviter les doublons

Merci.

Re

j'ai un bouton Valider dans feuille de saisie qui fait le transfert d'une ligne

vers la feuille spécifiée je veux faire le contrôle sur

le N° de Fact si il est en double

je ne s’est pas comme écrire en vba

code bouton:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim li As Long, co As Long, st As String, s As String
li = Target.Row
co = Target.Column
If Target.Value = "" Then GoTo fin
If li < lidebFJ Then GoTo fin
If Not Intersect(Target, Columns(coclic)) Is Nothing Then
  s = Target.Value
  If s = txtS Then MsgBox "ligne déjà traitée ": GoTo fin
  st = Cells(li, codatFJ + 2).Value
  If st = "" Then GoTo fin
  Call valider(st, li)
  Sheets(FJ).Cells(li, co).Value = txtS
  Sheets(FJ).Cells(li, co).Interior.ColorIndex = rouge
End If
fin:
Sheets(FJ).Select
Sheets(FJ).Cells(li + 1, co).Select
End Sub

colonne qui contient le n° de facture: colonne B

module1 :

Option Explicit

' feuille MVT Journalier
Public Const FJ = "MVT Journalier"
Public Const coclic = 20    'colonne T
Public Const lidebFJ = 4
Public Const codatFJ = 10
Public Const lifinFJ = 45

' feuilles sous traitants
Public Const codatFS = 1
Public Const lidebFS = 8

' feuille modele
Public Const FM = "modele"
Public Const TM = "TabMod"

' feuille BD
Public Const FB = "BD"
Public Const conomFS = 2

' texte saisi, valider
Public Const txtS = "saisi"
Public Const txtV = "valider"

' couleurs saisi, valider
Public Const rouge = 3
Public Const vert = 4

' heuteur ligne Page - n -
Public Const htLignePage = 30

Public Sub valider(st, li)
Dim plage1 As Range, plage2 As Range, lili As Long, plage3 As Range
Dim obj As Object, liobj As Long, nbpg As Long, nupg As Long
Application.ScreenUpdating = False
lili = lidebFS
With Sheets(st)
  ' recupération du nombre de pages
  nbpg = Application.WorksheetFunction.CountIf(.Columns(codatFS), "Page*")
  ' ligne debut derniere page
  Set obj = .Columns(codatFS).Find("Page - " & nbpg, , , xlPart)
  If obj Is Nothing Then
    MsgBox "erreur page ": Exit Sub
  End If
  liobj = obj.Row
  lili = liobj + 3
  While .Cells(lili, codatFS).Value <> ""
    lili = lili + 1
  Wend
  ' on a trouve une ligne vide
  ' si la ligne suivante contient le mot Total on passe à la page suivante
  ' et on ajoute 2 lignes pour ajouter un tableau
  If InStr(1, .Cells(lili + 1, codatFS).Value, "Total") > 0 Then
    lili = lili + 2
    Call AjouteTableau(st, lili, nbpg)
    ' on ajoute 3 lignes pour la donnée suivante
    lili = lili + 3
  End If
End With
' plages à copier
With Sheets(FJ)
  Set plage1 = .Range(.Cells(li, codatFJ), .Cells(li, codatFJ + 1))
  Set plage2 = .Range(.Cells(li, codatFJ + 3), .Cells(li, codatFJ + 7))
  Set plage3 = .Cells(li, codatFJ + 8)
End With
' coller les plages en feuille st
plage1.Copy Sheets(st).Cells(lili, codatFS)
plage2.Copy Sheets(st).Cells(lili, codatFS + 2)
plage3.Copy Sheets(st).Cells(lili, codatFS + 9)
End Sub

Public Sub ValiderSelection()
Dim li As Long, plage As Range, cel As Range, st As String
Set plage = Selection
If plage.Columns.Count > 1 Then Exit Sub
If plage.Column <> coclic Then Exit Sub
If MsgBox("Valider selection ", vbYesNo) <> vbYes Then Exit Sub
For Each cel In plage
  If cel.Value = txtV Then
    li = cel.Row
    st = Sheets(FJ).Cells(li, codatFJ + 2)
    If st <> "" Then Call valider(st, li)
    cel.Value = txtS
    cel.Interior.ColorIndex = rouge
  End If
Next cel
End Sub

' ajoute un tableau à la feuille st, ligne li avec np comme n° de page
Public Sub AjouteTableau(st, li, np)
With Sheets(st)
  Range(TM).Copy .Cells(li, codatFS)
  ' maj le n° de page et regle la hauteur de ligne
  .Cells(li, codatFS).Value = "Page - " & np + 1 & " -"
  .Rows(li & ":" & li).RowHeight = htLignePage
End With
End Sub

' ajoute la feuille de nom st
Public Sub AjouteFeuille(st As String)
Sheets("modele").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
  .Name = st
  .Cells(1, 1).Value = st
End With
End Sub

Public Sub RAZ()
Dim plage As Range
If MsgBox("Etes vous sûr de tout remettre à zéro ?", vbYesNo) <> vbYes Then Exit Sub
With Sheets(FJ)
  Set plage = .Range(.Cells(lidebFJ, codatFJ), .Cells(lifinFJ, codatFJ + 10))
  plage.ClearContents
  Set plage = .Range(.Cells(lidebFJ, coclic), .Cells(lifinFJ, coclic))
  plage.Value = txtV
  plage.Interior.ColorIndex = vert
End With
End Sub

' pour voir si la feuille nomF existe
Public Function FeuilleExiste(nomF As String) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (Sheets(nomF) Is Nothing)
End Function

' non utilisé
Public Function NomFeuille()
Application.Volatile
NomFeuille = ActiveSheet.Name
End Function

le bouton valider fait le transfert d'une seul ligne contenant

8 colonnes.

J'ai modifié le code de la fonction valider(), elle va vérifier que le n° de facture n'est pas présent dans la feuille de destination.  Tu avais mentionné qu'il fallait vérifier dans 12 feuilles, est-ce exact?

Si le numéro de facture  n'est pas en colonne B dans le feuille source, il faut modifier la constante cofacFJ dans la fonction.

Public Sub valider(st, li)
Const cofacFJ = 2  ' numero de colonne de la facture dans la feuille source
Const cofacFS = 2  ' numero de colonne de la facture dans la feuille destination
Dim plage1 As Range, plage2 As Range, lili As Long, plage3 As Range
Dim obj As Object, liobj As Long, nbpg As Long, nupg As Long
Application.ScreenUpdating = False
If Not Sheets(st).Columns(cofacFS).Find(Sheets(FJ).Cells(li, cofacFJ)) Is Nothing Then
    lili = lidebFS
    With Sheets(st)
      ' recupération du nombre de pages
      nbpg = Application.WorksheetFunction.CountIf(.Columns(codatFS), "Page*")
      ' ligne debut derniere page
      Set obj = .Columns(codatFS).Find("Page - " & nbpg, , , xlPart)
      If obj Is Nothing Then
        MsgBox "erreur page ": Exit Sub
      End If
      liobj = obj.Row
      lili = liobj + 3
      While .Cells(lili, codatFS).Value <> ""
        lili = lili + 1
      Wend
      ' on a trouve une ligne vide
      ' si la ligne suivante contient le mot Total on passe à la page suivante
      ' et on ajoute 2 lignes pour ajouter un tableau
      If InStr(1, .Cells(lili + 1, codatFS).Value, "Total") > 0 Then
        lili = lili + 2
        Call AjouteTableau(st, lili, nbpg)
        ' on ajoute 3 lignes pour la donnée suivante
        lili = lili + 3
      End If
    End With
    ' plages à copier
    With Sheets(FJ)
      Set plage1 = .Range(.Cells(li, codatFJ), .Cells(li, codatFJ + 1))
      Set plage2 = .Range(.Cells(li, codatFJ + 3), .Cells(li, codatFJ + 7))
      Set plage3 = .Cells(li, codatFJ + 8)
    End With
    ' coller les plages en feuille st
    plage1.Copy Sheets(st).Cells(lili, codatFS)
    plage2.Copy Sheets(st).Cells(lili, codatFS + 2)
    plage3.Copy Sheets(st).Cells(lili, codatFS + 9)
Else
    MsgBox "doublon"
End If
End Sub

Bonjour

J'ai modifier le code mais j’ai taper un numéro en double mais

li ne signale pas qu’il en double

et est ce qu'on peu localiser oû ce trouve le double

merci a vous lire

Re:

oui bien sur contrôle sur toutes les feuilles (12 et plus)

si je veux ajouter nouveau fournisseur dans BD double clic

la feuille sera créer automatiquement .

chaque jour je fait le saisie de nouveau pièces règlement et factures

et je fait le transfert

ci-joint mon fichier :https://www.cjoint.com/c/NGyi6dOYHjk

merci pour votre collaboration.

oui

ca marche bien il signale le doublons et pas de  transfert de ligne  et le bouton indique saisi? ,est ce qu’on peu indiquer oû ce trouve le doublon?

cad(dans quel fiche existe-t’il).

Ce code ( pour la feuille MVT Journalier) recherche un doublon dans toutes les feuilles ayant "Date" en A6:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const cofacFJ = 11  ' numero de colonne de la facture dans la feuille source
Const cofacFS = 2  ' numero de colonne de la facture dans la feuille destination
Dim li As Long, co As Long, st As String, s As String, doub As Range, fl As Worksheet
li = Target.Row
co = Target.Column
If Target.Value = "" Then GoTo fin
If li < lidebFJ Then GoTo fin
If Not Intersect(Target, Columns(coclic)) Is Nothing Then
    s = Target.Value
    If s = txtS Then MsgBox "ligne déjà traitée ": GoTo fin
    st = Cells(li, codatFJ + 2).Value
    If st = "" Then GoTo fin
    For Each fl In ThisWorkbook.Worksheets
        If fl.[A6] = "Date" Then
            Set doub = fl.Columns(cofacFS).Find(Sheets(FJ).Cells(li, cofacFJ))
            If Not doub Is Nothing Then
                MsgBox "doublon ligne " + CStr(doub.Row) + " de la feuille " + fl.Name
                GoTo fin
            End If
        End If
    Next fl
    Call valider(st, li)
    Sheets(FJ).Cells(li, co).Value = txtS
    Sheets(FJ).Cells(li, co).Interior.ColorIndex = rouge
End If
fin:
Sheets(FJ).Select
Sheets(FJ).Cells(li + 1, co).Select
End Sub

oui

le contrôle ce fait surtout sur les N° fact ou chèque

colonne B.

maintenant j'ai exécuter le nouveau code et ca marche très bien (le bouton reste vert

et le transfert de ligne n'est pas effectuer et indique ou ce trouve le doublon)

c'est ce que je cherche a faire

merci beaucoup monsieur

si jamais, comment est ce que je veux revenir

encore merci et bonne journée.

re;

pardon je revient :  il ya pas de doublon le transfert ne marche pas

Call valider(st, li)
  Sheets(FJ).Cells(li, co).Value = txtS
  Sheets(FJ).Cells(li, co).Interior.ColorIndex = rouge

ne s’exécute pas msg: doublon a la ligne 2

c'est pas nécessaire de faire le contrôle sur date en A6

merci.

oui

mais le nouveau code m'indique le chemin oû ce trouve le doublon