Discussion :

[cag's]

Bonjour à tous,

Je vous explique ce que je fais:
J'ai une feuille "Données" qui contient beaucoup de champs dont :
- Un numéro de service
- Un prix
- un code

Je souhaite alors compter à partir de ces champs le nombre de ligne unique afin de récupérer la quantité de chaque ligne. Je sais pas si je suis claire..Un exemple sera encore mieux :

si on a dans les données :
N° --- Prix --- code
1 --- 54 ---- 002
3 --- 39 ---- 003
4 --- 54 ---- 002
1 --- 54 ---- 002
3 --- 39 ---- 003
3 --- 54 ---- 002

le résultat sera :
N° --- Prix --- code --- Quantité
1 --- 54 ---- 002 --- 2
3 --- 39 ---- 003 --- 2
4 --- 54 ---- 002 --- 1
3 --- 54 ---- 002 --- 1

Pour faire cela, ma méthode est la suivante :
- je parcours toutes les lignes dans "données" et je colle les champs que je souhaite récupérer dans une feuille "Quantités" (procédure1)
- dans un second temps je parcours les lignes qui viennent d'être collées dans "Quantités". Ce parcours se fait deux à deux, on prends la première ligne puis on la compare avec toutes les autres. (procédure2)
- Si une ligne est similaire à la première je la supprime et j'ajoute +1 au compteur.
- Une fois terminé je passe à la deuxième ligne et ainsi de suite jusqu'à qu'il ne reste plus de doublons.

Je récupère bien pour chaque ligne la bonne quantité sauf que je traitement est très long (j'ai en moyenne 500lignes). D'où ma question: y'a t-il un moyen d'optimiser cette procédure ?


Le code que j'utilise

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 
 
'PROCEDURE 1
Sub CopierLesChampsDansQuantités()
 
Dim lig As Integer
 
    Sheets("Quantités").Range("D:D").NumberFormat = "@"
 
    Dim derniereLigne As Integer
 
    Set FL2 = Sheets("Données")
 
    ' Recherche de la dernière ligne dans l'onglet "Quantité"
    derniereLigne = Sheets("Quantités").Range("B" & Rows.Count).End(xlUp).Row + 1
 
    If derniereLigne > 8 Then
        Range("B8:E" & derniereLigne).EntireRow.Delete 'On supprime les anciennes données pour coller les nouvelles
    Else
 
        lig2 = 8 ' on commence à coller qu'à partir de la ligne 8
        For lig = 2 To Split(FL2.UsedRange.Address, "$")(4)
            ' N°de service
            Sheets("Quantités").Range("B" & lig2).Value = Sheets("Données").Range("R" & lig).Value
            ' Prix
            Sheets("Quantités").Range("C" & lig2).Value = Sheets("Données").Range("Q" & lig).Value
            ' Code 
            Sheets("Quantités").Range("D" & lig2).Value = Sheets("Données").Range("S" & lig).Value
            ' Quantités
            Sheets("Quantités").Range("E" & lig2).Value = 1
            lig2 = lig2 + 1
        Next
    End If
 
End Sub
 
'PROCEDURE 2
 
Sub CalculQuantite2()
 
'Déclaration des variables
Dim lig, lig2, cpt As Variant
Dim num, num2 As Variant
Dim Prix, Prix2 As Variant
 
Set FL1 = Worksheets("Quantités")
 
    'Compare la première ligne avec toutes les autres lignes du fichier
    For lig = 8 To Split(FL1.UsedRange.Address, "$")(4)
        For lig2 = lig + 1 To Split(FL1.UsedRange.Address, "$")(4)
            'Récupère le numéro de service et le prix des deux lignes comparées
            num = Sheets("Quantités").Range("B" & lig)
            num2 = Sheets("Quantités").Range("B" & lig2)
            Prix = Sheets("Quantités").Range("C" & lig)
            Prix2 = Sheets("Quantités").Range("C" & lig2)
            'Si les deux lignes comparées sont identiques
            If (num = num2 And Prix = Prix2) Then
                cpt = Sheets("Quantités").Range("E" & lig).Value
                Sheets("Quantités").Range("E" & lig).Value = cpt + 1 'On ajoute une quantité puisqu'une ligne identique a été trouvée
                Sheets("Quantités").Rows(lig2).Delete 'on supprime la ligne identique à celle comparée
                lig2 = lig2 - 1 'Vu qu'on vient de supprimer une ligne
            End If
        Next
    Next
 
    Set FL1 = Nothing
 
End Sub

[Michel_M]

Bonjour
sans macros ni formules:
as tu essayé avec un tableau croisé dynamique (TCD)?

si tu ne connais pas les TCD, regardedans les tutos (investissement en temps très profitable)

[cag's]

Meerci je ne sais pas pourquoi je n'y ai pas pensé avant -_- en tout cas ça marche

[vinc_bilb]

Bonjour,

Si vous voulez traiter le résultat autrement que par un TCD, le removeDuplicates marche très bien
Par exemple:

Code :

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

1
2
3
 
Set InpRng = ThisWorkbook.Wokjsheets("Data").range("A1").CurrentRegion
InpRng.RemoveDuplicates Columns:=(RngColAR), Header:=RngAsHeader

[78chris]

Bonjour

Bonjour,

Si vous voulez traiter le résultat autrement que par un TCD, le removeDuplicates marche très bien

Oui mais où est le calcul de la quantité ?

[Michel_M]

Et pour reprendre une nième fois la recommandation de Pierre Fauconnier
"Avant de penser VBA, pensez Excel"