raniou010
XLDnaute Nouveau
Bonjour , j'ai essayer de comprendre le problème mais malheureusement j'ai pas réussie , au faite ce code vérifie s'il y a des duplications dans la feuille 1 par rapport a des cellules(A,E,AM) puis il copie la ligne entiere dans une autre feuille , ce code fonctionne bien mais au niveau de la boucle For ou le résultat sera copié , la ligne(mon résultat) plusieurs fois .
voici le code
Sub CopyDuplicates()
Dim mycolor As Long, ws1 As Worksheet, ws2 As Worksheet, c1 As Integer, c2 As Integer, c3 As Integer 'Constantes
Dim i As Integer, ni As Integer, p As Integer, e As Integer, s As Integer, c As Integer, SearchID As String, MatchID As String 'Variables
'Déclaration constantes
Set ws1 = Sheet5 'Nom feuille 100'000 lignes
Set ws2 = Sheet6 ' Nom feuille où copier
c1 = 1 'Colonne A
c2 = 5 'Colonne E
c3 = 39 'Colonne AM
'Déclaration variables
With ws1
With .UsedRange
c = .Column 'Première colonne du tableau
s = .Row 'Première ligne du tableau
End With
e = .Cells(.Rows.Count, c).End(xlUp).Row 'Dernière ligne du tableau
End With
p = ws2.Cells(ws2.Rows.Count, c).End(xlUp).Row + 1 'Première ligne vide du tableau
'###############
'# DEBUT MACRO #
'###############
'Geler Excel
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For i = s To e
SearchID = ws1.Cells(i, c1).Value & ws1.Cells(i, c2).Value & ws1.Cells(i, c3).Value
For ni = s To e
If i <> ni Then
MatchID = ws1.Cells(ni, c1).Value & ws1.Cells(ni, c2).Value & ws1.Cells(ni, c3).Value
If SearchID = MatchID Then
ws1.Cells(ni, 1).EntireRow.Copy Destination:=ws2.Rows(p)
p = p + 1
End If
End If
Next ni
Next i
'Dégeler Excel
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
voici le code
Sub CopyDuplicates()
Dim mycolor As Long, ws1 As Worksheet, ws2 As Worksheet, c1 As Integer, c2 As Integer, c3 As Integer 'Constantes
Dim i As Integer, ni As Integer, p As Integer, e As Integer, s As Integer, c As Integer, SearchID As String, MatchID As String 'Variables
'Déclaration constantes
Set ws1 = Sheet5 'Nom feuille 100'000 lignes
Set ws2 = Sheet6 ' Nom feuille où copier
c1 = 1 'Colonne A
c2 = 5 'Colonne E
c3 = 39 'Colonne AM
'Déclaration variables
With ws1
With .UsedRange
c = .Column 'Première colonne du tableau
s = .Row 'Première ligne du tableau
End With
e = .Cells(.Rows.Count, c).End(xlUp).Row 'Dernière ligne du tableau
End With
p = ws2.Cells(ws2.Rows.Count, c).End(xlUp).Row + 1 'Première ligne vide du tableau
'###############
'# DEBUT MACRO #
'###############
'Geler Excel
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For i = s To e
SearchID = ws1.Cells(i, c1).Value & ws1.Cells(i, c2).Value & ws1.Cells(i, c3).Value
For ni = s To e
If i <> ni Then
MatchID = ws1.Cells(ni, c1).Value & ws1.Cells(ni, c2).Value & ws1.Cells(ni, c3).Value
If SearchID = MatchID Then
ws1.Cells(ni, 1).EntireRow.Copy Destination:=ws2.Rows(p)
p = p + 1
End If
End If
Next ni
Next i
'Dégeler Excel
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub