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
MarshPosté 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
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