Discussion :

[bilou_12]

Bonjour,

Dans le cadre d'un exercice, je souhaite faire un ranking un peu comme les agences de notations.

Dans la feuille 1, j'ai 4000 entreprises portant chacune un n° pr les identifier en colonne A, une année en colonne B et leur note historique pour l'année correspondante en colonne L.

Je souhaite faire des petites matrices en Feuil 3 pour savoir de manière précise, combien d'entreprises classées AAA en 1995 sont restées AAA en 1996 ou devenues AA etc...

Ainsi, j'ai réalisé le bout de code suivant:

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
Sub MatriceTransitionAAA9596()
 
Dim i As Integer
Dim j As Integer
 
j = 0
With Sheets("Feuil3").Cells(11, "B")
    For i = 2 To 830
 
        If Sheets("Feuil1").Cells(i, "A") = Sheets("Feuil1").Cells(i + 1, "A") Then
            If Sheets("Feuil1").Cells(i, "B").Value = 1995 And Sheets("Feuil1").Cells(i + 1, "B").Value = 1996 Then
                If Sheets("Feuil1").Cells(i, "L") = "AAA" Then
                    If Sheets("Feuil1").Cells(i + 1, "L") = "AAA" Then
                    .Value = .Value + 1
                    End If
                End If
            End If
        End If
 
    Next
End With
 
With Sheets("Feuil3").Cells(11, "C")
    For i = 2 To 830
 
        If Sheets("Feuil1").Cells(i, "A") = Sheets("Feuil1").Cells(i + 1, "A") Then
            If Sheets("Feuil1").Cells(i, "B").Value = 1995 And Sheets("Feuil1").Cells(i + 1, "B").Value = 1996 Then
                If Sheets("Feuil1").Cells(i, "L") = "AAA" Then
                    If Sheets("Feuil1").Cells(i + 1, "L") = "AA" Then
                    .Value = .Value + 1
                    End If
                End If
            End If
        End If
 
    Next
End With

Je vous passe toutes les notes car ca deviendrait redondant...

Ma macro fonctionne mais je me doute que le code est pas optimisé...

Je voudrais savoir si quelqu'un a une meilleure idée que la mienne?

Merci d'avance!

[jfontaine]

Bonjour,

As tu pensé a utiliser un Tableau Croisée Dynamique (TCD)?

[bilou_12]

Non... Je connais pas!

Je me renseigne! Merci du conseil!

[BlueMonkey]

Bonsoir,

Effectivement les Tableaux Dynamique Croisé serait une bonne solution pour ce type de problème.

Sinon pour ce qui était de l'optimisation du code #1 :
- la variable "j" ne sert pas,

- le choix des With n'est pas le meilleurs choix :
2 utilisations dans la boucle de Sheets("Feuil3").Cells(), alors que Sheets("Feuil1"), est appelé 6 fois par boucle.

- en remplaçant les With par Sheets("Feuil1"), on voit qu'il n'y a plus qu'une boucle utile.

- enfin on peut regrouper les tests sur Sheets("Feuil1").Cells(i, "L") = "AAA"

[Edit] : post en aveugle de #4. Ajout, peut être un With Sheets("Feuil1") ?

[helas]

Bonjour,
Avec une comparaison par ligne on gagne un peu de temps

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
 
k=timer
For i = 2 To 830
 
        If Sheets("Feuil1").Cells(i, "A") = Sheets("Feuil1").Cells(i + 1, "A") Then
            If Sheets("Feuil1").Cells(i, "B").Value = 1995 Then
              If Sheets("Feuil1").Cells(i + 1, "B").Value = 1996 Then
                If Sheets("Feuil1").Cells(i, "L") = "AAA" Then
                    Select Case Sheets("Feuil1").Cells(i + 1, "L")
                    Case "AAA"
                      Sheets("Feuil3").Cells(11, "B") = Sheets("Feuil3").Cells(11, "B") + 1
                    Case "AA"
                      Sheets("Feuil3").Cells(11, "C") = Sheets("Feuil3").Cells(11, "C") + 1
                    End Select
                End If
              End If
            End If
        End If
 
    Next
msgbox("Durée : " & timer-k)

En classant les comparaisons de la moins probable à la plus probable, on gagne encore du temps
Le Timer pour mesurer la durée d'execution