Amélioration et optimisation de code

Le 14/06/2013 à 10:07

Bonjour à toutes et à tous,

J'ai écris le code suivant :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Déclaration des variables
Dim i As Long
Dim SmasseA1 As Double, SmasseA2 As Double, SmasseB1 As Double, SmasseB2 As Double
Dim SmasseMA1 As Double, SmasseMA2 As Double, SmasseMB1 As Double, SmasseMB2 As Double
Dim KA1 As Long, KA2 As Long, KB1 As Long, KB2 As Long
Dim KMA1 As Long, KMA2 As Long, KMB1 As Long, KMB2 As Long

For i = 10 To 100
    If Cells(i, "B") = "A" Then
        If Cells(i, "C") = "1" Then
            SmasseA1 = SmasseA1 + Cells(i, "D").Value
            KA1 = KA1 + 1
            SmasseMA1 = SmasseMA1 + Cells(i, "D").Value
            KMA1 = KMA1 + 1
        ElseIf Cells(i, "C") = "2" Then
            SmasseA2 = SmasseA2 + Cells(i, "D").Value
            KA2 = KA2 + 1
            SmasseMA2 = SmasseMA2 + Cells(i, "D").Value
            KMA2 = KMA2 + 1
        End If
    ElseIf Cells(i, "B") = "B" Then
        If Cells(i, "C") = "1" Then
            SmasseB1 = SmasseB1 + Cells(i, "D").Value
            KB1 = KB1 + 1
            SmasseMB1 = SmasseMB1 + Cells(i, "D").Value
            KMB1 = KMB1 + 1
        ElseIf Cells(i, "C") = "2" Then
            SmasseB2 = SmasseB2 + Cells(i, "D").Value
            KB2 = KB2 + 1
            SmasseMB2 = SmasseMB2 + Cells(i, "D").Value
            KMB2 = KMB2 + 1
        End If
    End If
Next i

'Moyenne des masses
Range("I10") = SmasseA1 / KA1
Range("I11") = SmasseA2 / KA2
Range("I12") = SmasseB1 / KB1
Range("I13") = SmasseB2 / KB2

'Moyenne des masses max
Range("J10") = SmasseMA1 / KMA1
Range("J11") = SmasseMA2 / KMA2
Range("J12") = SmasseMB1 / KMB1
Range("J13") = SmasseMB2 / KMB2

End Sub

J'ai un tableau avec 4 colonnes qui me sert de base de données:

  • Equipements ( A ou B dans l'exemple mais peut prendre d'autres nom)
  • Type (1 ou 2 dans l'exemple mais peut prendre d'autre nom)
  • Masse
  • Masse Max

Dans un autre tableau sur la même feuille, je souhaite réaliser la moyenne des masses et de masses max pour chaque équipement identique de même masse.

Le code que je vous ai donné fonction mais demande à être optimiser car au lieu d'avoir A, B et 1, 2. Je souhaiterai Excel face lui même les regroupements équipements et type si cela est possible.

J'espère que je me suis bien fait comprendre!

Je vous remercie par avance pour votre aide.

Le 14/06/2013 à 10:33

Bonjour,

C'est futile je sais mais déjà il est possible de simplifier le début sous cette forme là

Dim SmasseA1 , SmasseA2 , SmasseB1 , SmasseB2 , SmasseMA1 , SmasseMA2 , SmasseMB1 , SmasseMB2 As Double
Dim i, KA1 , KA2 , KB1 , KB2 , KMA1 , KMA2 , KMB1 , KMB2 As Long
Le 14/06/2013 à 10:53

Bonjour,

C'est futile je sais mais déjà il est possible de simplifier le début sous cette forme là

Dim SmasseA1 , SmasseA2 , SmasseB1 , SmasseB2 , SmasseMA1 , SmasseMA2 , SmasseMB1 , SmasseMB2 As Double

Dim i, KA1 , KA2 , KB1 , KB2 , KMA1 , KMA2 , KMB1 , KMB2 As Long

Oula, pas du tout.

Seules les dernières variables seront typées, les autres seront Variant.

Pourquoi ne pas faire un TCD ?

eric

17exemple.xlsm (25.21 Ko)
Le 14/06/2013 à 11:00

Un TCD?

Le 14/06/2013 à 11:22

Un Tableau Croisé Dynamique.

Si tu ne connais pas c'est l'occasion. Demande un peu d'investissement au début pour comprendre, mais hyper puissant pour avoir une synthèse de résultats sans mettre une seule formule.

Tableau Croisé Dynamique (TCD) : http://www.mdf-xlpages.com/modules/smartsection/item.php?itemid=109

Regarde le fichier que j'avais joint.

eric

Le 14/06/2013 à 11:31

Dans ce cas mes excuses à toutes et à tous...

On m'aurait menti ?

Mince...Toutes mes déclarations à refaire !

Merci eriiiiiiic

Le 14/06/2013 à 11:35

Merci Eriiic! Je vais essayer!

Le 14/06/2013 à 13:24

J'avoue que cet outil est puissant. Mais je n'ai pas le temps pour l'optimiser correctement et mon responsable prèfére que je reste sur du code Vba.

Donc si quelqu'un à une idée, je suis preneuse. Merci =)

Le 14/06/2013 à 13:52

Dites à votre responsable (en souriant bien sûr), qu'il faut trois fois plus de temps pour trouver une personne qui fera la maintenance du code vba quand le fichier aura besoin d'évoluer que pour un TCD ! Et que pour rappel...Personne n'a le temps de s'en occuper !

Le 14/06/2013 à 13:55
Lean a écrit :

Dites à votre responsable (en souriant bien sûr), qu'il faut trois fois plus de temps pour trouver une personne qui fera la maintenance du code vba quand le fichier aura besoin d'évoluer que pour un TCD ! Et que pour rappel...Personne n'a le temps de s'en occuper !

Il m'a très gentillement répondu : "c'est à celà que servent les stagiaire,mademoiselle"

Le 14/06/2013 à 14:12

C'est un bon début ! Il sait au moins que vous passez 2h de votre temps à faire ce qui pourrait être fait en 10 minutes !

Un rapport Coût / Qualité / Délai à toute épreuve !

Le 14/06/2013 à 14:16

Nous sommes d'accord mais cela ne m'aide pas à avancer et à moins perdre mon temps

Le 14/06/2013 à 15:21

Re,

c'est vraiment un très gros travail pour remplacer 5 clics souris...

Une proposition de méthode :

Déjà il faut que tu te crées des listes sans doublon des Equipements et des Désignations (voir avec l'objet Dictionary, tu as plein d'exemples sur le net)

Puis que tu te crées une liste des couples Equipement/Désignation, et que tu balaies les données pour sommer et compter tous les couples.

Quand c'est fini tu balaies ta liste des couples pour calculer la moyenne et supprimer les vides.

Et tu peux mettre le résultat sur ta feuille. Oufff

Autre méthode :

Mettre le TCD dans une feuille masquée.

Par macro rafraichir le TCD, analyser la colonne 1 pour récupérer Equipement et Désignation, tu as les moyennes en colonnes 2 et 3. Reconstruire ta table de résultat avec ça.

Bon courage, si tu débutes c'est ardu quelque soit la méthode...

eric

Le 14/06/2013 à 17:39

Bonsoir,

Une solution qui allie un TCD et VBA

CTRL+Q pour lancer la procédure.

A vous relire

Cdlt.

Option Explicit
Public Sub TCD()
'CTRL+Q pour lancer la procédure
Dim wS As Worksheet
Dim Plage As Range, PTCache As PivotCache, PT As PivotTable
Dim p As PivotField

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    On Error Resume Next
        ActiveWorkbook.Worksheets("Résultat").Delete
    On Error GoTo 0

    Set wS = Worksheets(1)
    Set Plage = wS.Range("A1").CurrentRegion

    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=Plage)

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Résultat"

    Set PT = PTCache.CreatePivotTable(TableDestination:=Worksheets("Résultat").Range("A1"), _
        TableName:="TCD_1")

    With PT
        .PivotFields("Equipement").Orientation = xlRowField
        .PivotFields("Désignation").Orientation = xlRowField
        With .PivotFields("Masse")
            .Orientation = xlDataField
            .Caption = "m Masse"
            .Function = xlAverage
            .NumberFormat = "0.000"
        End With
        With .PivotFields("Masse max")
            .Orientation = xlDataField
            .Caption = "m Masse max"
            .Function = xlAverage
            .NumberFormat = "0.000"
        End With
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With

        .ColumnGrand = False
        .RowGrand = False
        .FieldListSortAscending = True
        .ShowDrillIndicators = False

        For Each p In .PivotFields
            If p.Orientation = 1 Then p.Subtotals = Array(False, False, False, False, _
                False, False, False, False, False, False, False, False)
        Next p
    End With

    Application.DisplayAlerts = True

    Set wS = Nothing: Set Plage = Nothing: Set PTCache = Nothing: Set PT = Nothing

End Sub
29orchyd-v1.xlsm (23.30 Ko)
Rechercher des sujets similaires à "amelioration optimisation code"