Macro pour isoler les doublons d'un fichier

**tdmort** · 24/03/2022, 17h18

Bonjour à tous.

Tout d'abord, permettez moi de m'excuser si je ne suis pas dans la bonne catégorie du forum.

Je suis à la recherche d'une macro, sur MSExcel2016, pour isoler dans une autre feuille d'un classeur, des doublons possibles dans une feuille.

Je m'explique :

Je m'occupe de sécurité informatique, et pour des campagnes de patch, j'ai un fichier d'export avec plus de 1000 noms de machines.

L'idée est de comparer ce fichier, avec un autre fichier, et tout les doublons sont des machines que je doit obligatoirement patcher.

Pour ce faire, je concatène les 2 fichiers dont j'ai besoin, et à la suite, j'aimerais trouver une macro, me permettant d'isoler tout les doublons, dans une autre feuille du classeur, et les supprimer de leurs emplacement initiale.

Auriez vous une petite idée ?

En vous remerciant par avance.

**EricDgn** · 30/03/2022, 00h27

Bonjour,

Il y a dans Excel une fonction pour "supprimer les doublons" dans le groupe "Outils de données" de l'onglet "Données".
Nom : SupprimerDoublons.png
Affichages : 165
Taille : 7,6 Ko

Nom : SupprimerDoublons.png
Affichages : 165
Taille : 7,6 Ko

.

Cordialement.

**tdmort** · 30/03/2022, 10h44

Bonjour, et merci pour ta réponse.

Cependant, je ne cherche pas à supprimer les doublons, mais bien à les isoler dans une feuille a part.

Merci

**ONTAYG** · 07/04/2022, 16h04

Bonjour,

Tu vas dans Mise En Forme conditionnelle\Règles de Mise en surbrillance des cellules\Valeurs en Double

Cela te permettra de les isoler visuellement.

ONTAYG

**jurassic pork** · 07/04/2022, 16h04

Hello,
le fichier est un fichier texte ? il n'y a qu'un nom de machine par ligne ? c'est un fichier windows ou unix ( CRLF ou LF ) ?
Ami calmant, J.P

**EricDgn** · 07/04/2022, 18h22

Bonjour,

Un début de solution, à tester, compléter, adapter, simplifier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Option Explicit
Option Base 1
 
Sub ChargerDoublons()
    Dim wbA As Workbook, wbB As Workbook
    Dim wshA As Worksheet, wshB As Worksheet
    Dim kC As Long, rA As Range, rB As Range, rD As Range
    Dim arrA() As Variant, arrB() As Variant, arrD As Variant
    Dim j As Long, k As Long
    Set wbA = Application.Workbooks.Open(ThisWorkbook.Path & "\Fichier_A.xlsx", , True)
    Set wbB = Application.Workbooks.Open(ThisWorkbook.Path & "\Fichier_B.xlsx", , True)
    Set wshA = wbA.Worksheets("Feuil1")
    Set wshB = wbB.Worksheets("Feuil1")
    '--- il est supposé que les 2 feuilles ont la même présentation
    '--- que la ligne 1 est une ligne de titres
    '--- qu'il n'y pas de cellules vides dans la colonne à comparer
    kC = 1      '--- colonne contenant les éléments à comparer (recheche doublons)
    Set rA = wshA.Range(wshA.Cells(2, kC), wshA.Cells(2, kC).End(xlDown))
    Set rB = wshB.Range(wshB.Cells(2, kC), wshB.Cells(2, kC).End(xlDown))
    arrA = rA
    arrB = rB
    ThisWorkbook.Activate
    Worksheets("Doublons").Select
    Cells.Clear
    Range("A1").Select
    '====== liste les doublons
    For j = 1 To UBound(arrA)
        Debug.Print arrA(j, 1)
        For k = 1 To UBound(arrB)
            If arrA(j, 1) = arrB(k, 1) Then
                wshA.Rows(j + 1).Copy ActiveCell
                ActiveCell.Offset(1, 0).Select
            End If
        Next k
    Next j
    Set rD = Range(Cells(1, kC), Cells(1, kC).End(xlDown))  '--- range doublons
    arrD = rD
 
    Stop
    '==== supprime les doublons dans fichier B
    wshB.Activate
    k = Cells(2, kC).End(xlDown).Row            '--- dernière ligne
    Do
        For j = 1 To UBound(arrD)
            If Cells(k, kC) = arrD(j, 1) Then
                Rows(k).Delete
                Exit For
            End If
        Next j
        k = k - 1                               '--- remonte
    Loop Until k = 0
End Sub

Cordialement.

**Zekraoui_Jakani** · 08/04/2022, 00h17

Nom : Capture Ecran Doublons.jpg
Affichages : 144
Taille : 196,3 Ko

**jurassic pork** · 08/04/2022, 08h03

Hello,
voici une solution pour un traitement de fichiers Texte. Cette solution utilise des objets fso et ArrayList.
Le principe :
On lit le fichier texte source contenant une machine par ligne, ligne par ligne. On regarde si la machine de la ligne est déjà dans la liste de toutes les machines et n'est pas déjà présente dans la liste des doublons. Si cela est vrai on l'ajoute à la liste des doublons sinon on l'ajoute à la liste de toutes les machines. Quand on a fini de lire le fichier source, on trie la liste des doublons et on écrit la liste des doublons dans le fichier destination.
Je n'ai pas utiliser des collections au lieu des ArrayList car il n'y a pas de fonction "contains", de tri et de conversion en tableau dans les collections.
Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub IsolerDoublons()
Const ForReading = 1
Const ForWriting = 2
    Dim fso As Object
    Dim listeMachinesAll, listeDoublons As Object
    Dim ficSource, ficDest As Object
    Dim ligne As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set listeMachinesAll = CreateObject("System.Collections.ArrayList")
    Set listeDoublons = CreateObject("System.Collections.ArrayList")
    Set ficSource = fso.OpenTextFile("D:\tmp\machines.txt", ForReading)
    Set ficDest = fso.CreateTextFile("D:\tmp\doublons.txt", True)
    While Not ficSource.AtEndOfStream
        ligne = ficSource.ReadLine
        If listeMachinesAll.contains(ligne) And _
           Not listeDoublons.contains(ligne) Then
           listeDoublons.Add ligne
        Else
           listeMachinesAll.Add ligne
        End If
    Wend
    ficSource.Close
    Debug.Print "Nombre de doublons : " & CStr(listeDoublons.Count)
    listeDoublons.Sort ' Tri
    ficDest.Write (Join(listeDoublons.ToArray, vbCrLf) + vbCrLf)
    ficDest.Close
    Set fso = Nothing: Set ficSource = Nothing: Set ficDest = Nothing
    Set listeMachinesAll = Nothing: Set listeDoublons = Nothing
End Sub

Ami calmant, J.P

**78chris** · 08/04/2022, 10h35

Bonjour à tous

Se fait en quelques clics avec PowerQuery intégré à Excel

Exemple avec les fichiers d'Ericdgn : modifier le chemin des fichiers (cellules jaunes puis clic droit dans le tableau de résultats, Actualiser

**BENNASR** · 08/04/2022, 10h49

Bonjour 78chris
avez vous un lien de téléchargement de powerquery pour excel 2010 et windows 7 64bits svp

**78chris** · 08/04/2022, 10h54

Bonjour

https://www.microsoft.com/fr-fr/down....aspx?id=39379

Prendre 32 bits si Excel 2010 est installé en 32 bits sur un Win 64 bits : c'est le nombre de bits de l'installation Office qui compte