XL 2019 Excel VBA - Supprimer les doublons

OuiOuiNonNon

XLDnaute Nouveau
Voila ce que j'aimerais faire en VBA : J'ai plusieurs fichiers dans un dossier, j'aimerais supprimer les doublons automatiquement, par exemple, dans le fichier "COLLARD_GILBERT_28_12" la colonne S1 est remplie, mais dans le fichier "COLLARD_GILBERT_24_12" la colonne S1 est également remplie, ce qui fait doublon.

PS : Dans le dossier, il y a plusieurs noms différents, si la colonne S1 est remplie pour deux fichiers avec deux noms différents, ce n'est pas comptabilisé comme un doublon.
 

Pièces jointes

  • COLLARD_GILBERT_28_12.xlsx
    11.5 KB · Affichages: 26
  • COLLARD_GILBERT_26_12.xlsx
    11.2 KB · Affichages: 7
  • COLLARD_GILBERT_24_12.xlsx
    11.2 KB · Affichages: 8
Solution
Enfaite quand je disais doublons, je voulais dire : si il y a un chiffre dans une cellule du fichier X, qu'il soit identique ou non, alors on efface le contenu de la cellule du fichier Maitre.
Si j'ai bien compris d'après ton fichier résultat joint précédemment.
VB:
Option Explicit

'cette macro n'ouvre qu'un seul fichier
Sub Boucle_Fichiers()
'ouvrir à partir de ce fichier tous les fichiers excel se trouvant dans le même répertoire
   Dim Fichier As String, Chemin As String, Wb As Workbook, Wa As Workbook, Nomfichier As String, MonClasseur As String
   Dim dlig As Long, dcol As Integer, Lig As Integer, Col As Integer, dligX As Integer, Rng As Range
   Set Wa = ThisWorkbook
   MonClasseur = Wa.Name
   Chemin = Wa.Path
   With Wa...

Staple1600

XLDnaute Barbatruc
Bonjour le fil, OuiOuiNonNon

Oui, on commence ses messages par un petit bonjour
Oui, c'est écrit dans la charte du forum
Non, j'ai pas le temps de la lire (est un argument qui n'en est pas un)
Non, je savais pas (non plus, car c'était explicite*)
;)

* => [A LIRE AVANT DE POSTER] Charte du forum
 

OuiOuiNonNon

XLDnaute Nouveau
Bonsoir cp4,
Je met ci-joints le résultat escompté. Pour les explications, je vais essayer de faire au mieux : J'aimerais que le fichier "COLLARD_GILBERT_28_12" se rende compte qu'il existe d'autre fichier avec le même nom et prénom (Collard Gilbert), dans ces fichiers, les colonnes S1 à S7 sont déjà remplis, donc il faut supprimer ces colonnes du fichier "COLLARD_GILBERT_28_12".
 

cp4

XLDnaute Barbatruc
Bonjour,

@OuiOuiNonNon : Tu m'as fait perdre du temps avec ton fichier résultat. En effet, sur la base de tes fichiers joints à ton premier post. Le résultat est tout autre chose. Mais bon, en cette fin d'année je me suis promis d'être très cool.
/!\ Les fichiers doivent être dans le même répertoire (dossier). Mettre le code dans un module standard et enregistrer le fichier au format xlsm, puis exécuter le code.
VB:
Option Explicit

'cette macro n'ouvre qu'un seul fichier
Sub Boucle_Fichiers_Dossier()
'ouvrir à partir de ce fichier tous les fichiers excel se trouvant dans le même répertoire
   Dim Fichier As String, Chemin As String, Wb As Workbook, Wa As Workbook, Nomfichier As String, MonClasseur As String
   Dim dlig As Long, dcol As Integer, Lig As Integer, Col As Integer
   Set Wa = ThisWorkbook
   MonClasseur = Wa.Name
   Chemin = Wa.Path
   With Wa
      dlig = Feuil1.Cells(Rows.Count, 4).End(xlUp).Row
      dcol = Feuil1.Cells(2, Cells.Columns.Count).End(xlToLeft).Column
   End With

   Nomfichier = Left(Split(ThisWorkbook.Name, ".")(0), 15)

   Fichier = Dir(Chemin & "\*.xls*")
   Do
      If Fichier = "" Then Exit Do
      If Fichier <> ThisWorkbook.Name Then
         If Fichier Like Nomfichier & "*.xlsx" Then
            Set Wb = Workbooks.Open(Chemin & "\" & Fichier)
            'suite de la procedure
            For Col = 5 To dcol
               For Lig = 3 To dlig
                  If Workbooks(MonClasseur).Sheets(1).Cells(Lig, Col).Value <> "" Then
                     If Workbooks(MonClasseur).Sheets(1).Cells(Lig, Col).Value = Workbooks(Fichier).Sheets(1).Cells(Lig, Col).Value Then
                        Workbooks(MonClasseur).Sheets(1).Cells(Lig, Col) = ""
                     End If
                  End If
               Next Lig
            Next Col
            Application.DisplayAlerts = False
            Wb.Close True
            Application.DisplayAlerts = True
            Set Wb = Nothing
         End If
      End If

      Fichier = Dir()
   Loop
   Wa.Save
   Set Wa = Nothing
   MsgBox "Traitement terminé!", vbOKOnly + vbInformation, "TRAITEMENT"
End Sub
Bonne journée.
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

[mauvais esprit matiné d'ironie millésime 2020]
écrit avec mon stylo Humour et Titillement, mine non grasse (mais néanmoins amicale)

Tu m'as fait perdre du temps avec ton fichier résultat
Perdre son temps, n'est-ce point là, la vocation du répondeur XLDien?
La plupart des questions fraichement posées ayant déjà traitées moult fois. Il y a donc une myriade de solutions qui prennent la poussière dans les archives du forum.
Et pourtant, nous perdons notre temps (libre) à l'insu de notre plein à continuer à répondre à des questions déjà résolues (ou presque)
Victimes de nos biais cognitifs, nous perdons notre temps derrière un écran et un clavier et développons surpoids et pathologies diverses pour le plus grand bénéfice des groupes pharmaceutiques (mais là je m'égare ;))
Alors vive le temps perdu, vive Excel et que sera, sera !

[/mauvais esprit matiné d'ironie millésime 2020]
 

cp4

XLDnaute Barbatruc
Bonjour le fil

[mauvais esprit matiné d'ironie millésime 2020]
écrit avec mon stylo Humour et Titillement, mine non grasse (mais néanmoins amicale)


Perdre son temps, n'est-ce point là, la vocation du répondeur XLDien?
La plupart des questions fraichement posées ayant déjà traitées moult fois. Il y a donc une myriade de solutions qui prennent la poussière dans les archives du forum.
Et pourtant, nous perdons notre temps (libre) à l'insu de notre plein à continuer à répondre à des questions déjà résolues (ou presque)
Victimes de nos biais cognitifs, nous perdons notre temps derrière un écran et un clavier et développons surpoids et pathologies diverses pour le plus grand bénéfice des groupes pharmaceutiques (mais là je m'égare ;))
Alors vive le temps perdu, vive Excel et que sera, sera !

[/mauvais esprit matiné d'ironie millésime 2020]
Re, Staple1600;),

En fait, je voulais dire induit en erreur. Concernant, la perte de temps ça m'est arrivé quand je prenais de mauvaises décisions😜.

Bonne journée.
 

cp4

XLDnaute Barbatruc
Merci pour ces précieuses lignes de codes. J'ai une dernière requête, lorsque le chiffre n'est pas le même sur les deux fichiers, il ne va pas le compter comme doublons. Est-il possible de le compter comme doublon ?
Une ligne de code récupère juste le début du nom du fichier (sans les chiffres). C'est sur ce dernier que la condition est basée l'ouverture des fichiers à comparer.
OuiOuiNonNon.gif


si tu veux extraire plus de caractères modifie le chiffre qui se trouve à la fin de cette ligne de code:
Nomfichier = Left(Split(ThisWorkbook.Name, ".")(0), 15)

J'espère que c'est plus clair.

A+
 

OuiOuiNonNon

XLDnaute Nouveau
Merci pour l'explication gif, je me suis mal exprimé. Quand par exemple, dans une cellule du tableau (par exemple G5), dans le "COLLARD_GILBERT_26_12", il y a le chiffre 4, et dans cette même cellule du tableau dans le "COLLARD_GILBERT_28_12", il y a le chiffre 5, alors ce ne sera pas compté comme doublon parce que ce ne sont pas les mêmes chiffres, mais j'aurais aimé que cela compte comme doublons.
 

cp4

XLDnaute Barbatruc
Merci pour l'explication gif, je me suis mal exprimé. Quand par exemple, dans une cellule du tableau (par exemple G5), dans le "COLLARD_GILBERT_26_12", il y a le chiffre 4, et dans cette même cellule du tableau dans le "COLLARD_GILBERT_28_12", il y a le chiffre 5, alors ce ne sera pas compté comme doublon parce que ce ne sont pas les mêmes chiffres, mais j'aurais aimé que cela compte comme doublons.
Ta demande initiale concernée des doublons. Pour moi, tu voulais si fichierMaitre.Feuil1.Cells(x,y)= FichierX.Feuil1.Cells(x,y) alors on efface le contenu de la cellule du fichierMaitre.

Là, tu me donnes un exemple la cellule G5 dont les valeurs ne sont pas identiques. Que faire pour les autres cellules qui ne seront pas identiques? Pas très clair tout ça!
 

Discussions similaires

Statistiques des forums

Discussions
311 705
Messages
2 081 733
Membres
101 807
dernier inscrit
foued