Transférer le résultat des doublons sur un autre feuil !

Transférer le résultat des doublons sur un autre feuil ! - VB/VBA/VBS - Programmation

Marsh Posté le 22-02-2017 à 18:14:58    

Bonjour à tous,
 
j'ai un fichier excel qui contient 5 colonnes de A à E et presque 60300 lignes.
 
je travaille avec un code 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 !
[cpp][/cpp]
merci d'avance  
 
PS: voici ci-dessous mon code :  
 
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
 
 

Reply

Marsh Posté le 22-02-2017 à 18:14:58   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed