Discussion :

[SALOUAJI]

Bonjour à tous,

j'ai un fichier excel qui contient 5 colonnes de A à E et presque 60300 lignes

je travaille avec un code VBA son rôle est de trouver les doublon et supprimer en même temps les doublons < 3 et qui affiche les résultats final sur la Feuil"LISTE SANS LES DOUBLONS < 3" avec le nombre de chaque doublons,(Résultat détailler!).

le problème c'est que je veux pas les résultats bien détailler Je voudrais savoir combien d'alarme se répété sur chaque équipement de la colonne A.

En PJ un exemple simple pour illustrer ce que je souhaiterais faire.

je serai content si vous pouvez m'aider pour trouver les résultats comme expliquer en PJ la Feuil2 !

merci d'avance

PS: voici ci-dessous mon 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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
 
Dim derln&, tablo, dico As Object, i&, j&, tabloR(), k&
Dim f As Worksheet
 
Sub Doublons()
 
    Set f = ActiveSheet
    derln = Range("A" & Rows.Count).End(xlUp).Row
    Range("E2:E" & derln).ClearContents
    tablo = Range("A2:E" & derln)
    Set dico = CreateObject("Scripting.Dictionary")
 
    For i = 1 To UBound(tablo, 1)
        dico(tablo(i, 1) & tablo(i, 3)) = dico(tablo(i, 1) & tablo(i, 3)) + 1
    Next i
 
    k = 0
    For i = 1 To UBound(tablo, 1)
          tablo(i, 5) = dico(tablo(i, 1) & tablo(i, 3))
        If tablo(i, 5) >= 3 Then
            ReDim Preserve tabloR(5, k + 1)
            For j = 1 To 5
                tabloR(j - 1, k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i
 
    Range("G1").CurrentRegion.Offset(1, 0).ClearContents
    Range("A2").Resize(UBound(tablo, 1), 5) = tablo
    Range("G2").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
    Range("H2").Resize(dico.Count, 1) = Application.Transpose(dico.items)
 
    Sheets.Add
    Range("A2").Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
    f.Range("A1:E1").Copy Range("A1")
    f.Range("A:E").Copy
    Range("A:E").PasteSpecial xlPasteFormats
    Rows("1:1").Insert
 
    Range("B1") = "LISTE SANS LES DOUBLONS < 3"
    Rows("1:1").RowHeight = 42
    Range("B1").VerticalAlignment = xlCenter
    Range("B1").Select
End Sub