Discussion :

[MonSavon]

Bonjour,
je cherche une méthode pour vérifier si une ligne est présente en double, et si c'est le cas agir sur une case de la ligne correspondante aux deux doublons. Pour le moment j'ai fait 2 boucles imbriquées mais je ne sais pas si c'est la meilleure solution.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
For i = 2 To nb_ligne
TMP = F1.Cells(i, col_numprod).Value
 
    For j = i + 1 To nb_ligne
    If TMP = F1.Cells(j, col_numprod).Value Then
    cmtp = cmtp + 1
    F1.Cells(j, col_solde).Value = F1.Cells(j, col_solde).Value / 2
    F1.Cells(i, col_solde).Value = F1.Cells(i, col_solde).Value / 2
    End If
 
    Next j
Next i

EDIT : Je viens de faire tourner mon code sur mon fichier excel (55000 lignes) et le programme vient de planter...

[Menhir]

Peut-être pourrais-tu commencer par faire un tri sur ta liste avec la méthode Sort de l'objet Worksheet.
Ca raccourcirait beaucoup le temps de traitement de ta seconde boucle.

[Marc-L]

Bonjour,

ou utiliser la fonction de formule de feuille de calculs NB.SI ou la fonction VBA Find ou encore un filtre …

[Invité]

ça à l'air compliqué mai en réalité c'est très simple je me tien à ta disossion pour les explication.

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
Dim Collec As New Collection
Dim Cls As Classe1
Dim Clls As String
For I = 2 To nb_ligne
	If InStr("[;]" & Clls & "[;]", "[;]" & F1.Cells(I, col_numprod) & "[;]") = 0 Then
		Clls = Clls & "[;]" & F1.Cells(I, col_numprod) & "[;]"
		Set Cls = New Classe1
		Collec.Add Cls, "Cls_ & " & F1.Cells(I, col_numprod)
		 Set Cls = Nothing
	End If
	Collec("Cls_ & " & F1.Cells(I, col_numprod)).LirRange F1.Cells(I, col_solde)
Next
For I = 1 To Collec.Count
	Collec(I).maj
Next

Code Classe1 :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private TArdess() As Range
Private I As Long
Public Sub LirRange(R As Range)
ReDim Preserve TArdess(I)
Set TArdess(I) = R
I = I + 1
End Sub
Public Sub maj()
Dim L As Long
For L = 0 To UBound(TArdess)
    TArdess(L).Value = TArdess(L) / (UBound(TArdess) + 1)
Next
End Sub