Optimisation de code

Bonsoir le forum,

je viens de finir un code pour récupéré certaines valeurs de mon onglet Produit.

Le code fonctionne impeccable mais je le trouve pas très efficient ! j'ai l'impression de faire 15 étapes là où il faudrait trois coups de cuillère à pot.

Je pense que l'on doit pouvoir utiliser un tableau virtuel plutôt qu'une boucle mais toutes mes tentatives se sont soldée par un échec.

De même j'ai défini 4 plages pour mes références secteur et leurs indexs pour pouvoir naviguer de l'un à l'autre mais j'arrive pas à récupere la valeur de l'index avec le nom et reciproquement, sauf là encore en passant par des boucles ( onglet Config)

Si quelqu'un peu jeter un oeil, car la j'ai déjà 3 boucles et si je continue comme ca je vais créer boucle d'or

Attention les puristes ca pique un peu

Sub Macro1()
'
' Macro1 Macro
'

'
  Dim NBesoin As String
  Dim Cel As Range
  Dim cell As Range
  Dim SCel As Range
  'Dim SR As Integer
  Dim VNBesoin As Integer
  Dim NBe As Range

  NBesoin = "LCH-MYEL" ' Valeur recuperée d'apres un userform, correspond aux valeurs colonne Jaune onglet produit

   For Each Cel In [N°B]
   If NBesoin = Cel.Value Then
   VNBesoin = Sheets("Config").Cells(Cel.Row, 2).Value ' ici je recupere la valeur de la cellule correspondant au numéro de besoin de la colonne "Code Besoin"
                                                        'de besoin de la colonne "Code Besoin", ca doit s'amélioré mais j'ai pas trouvé comment
   End If
   Next

With Sheets("Produit")
a = .Range("A1048576").End(xlUp).Row
Set RangNBesoin = Sheets("Produit").Range(.Cells(1, VNBesoin), .Cells(a, VNBesoin))
For Each NBe In RangNBesoin
    If NBe.Value = VNBesoin Then
    RC = .Cells(NBe.Row, 13).Value                                                           '   ici je recupere les valeurs que je souhaite afficher
    TX = .Cells(NBe.Row, 12).Value                                                       '   ici je recupere les valeurs que je souhaite afficher
    TI = .Cells(NBe.Row, 11).Value                                                       '   ici je recupere les valeurs que je souhaite afficher
    CMT = .Cells(NBe.Row, 10).Value                                                       '   ici je recupere les valeurs que je souhaite afficher
    DN = .Cells(NBe.Row, 6).Value                                                       '   ici je recupere les valeurs que je souhaite afficher
    RF = .Cells(NBe.Row, 5).Value
        For Each cell In .Range("W" & NBe.Row & ":AW" & NBe.Row)
        If cell <> "" Then
        For Each SCel In [N°S]
            If Left(SCel.Value, 2) = VNBesoin Then '   ici je recupere le code secteur onglet produit
            If cell.Value = SCel.Value Then

            NS = Sheets("Config").Cells(SCel.Row, 3).Value                      'et ici je recupère l'intitulé du secteur onglet Config

                With Sheets("Test")
                b = .Range("A1048576").End(xlUp).Row + 1    ' et la je copie les valeurs des variables
                .Cells(b, 1) = RC
                .Cells(b, 2) = NS
                .Cells(b, 3) = RF
                .Cells(b, 4) = DN
                .Cells(b, 6) = CMT
                .Cells(b, 12) = TI
                .Cells(b, 13) = TX
                End With
                End If
            End If
        Next
        End If
        Next
    End If
Next
End With
End Sub

Bonsoir,

ci-dessous proposition d'amélioration

Sub Macro2()
    Dim NBesoin As String
    Dim cell As Range, cell1 As Range
    Dim VNBesoin As Integer
    Dim nb_lig As Integer, nb_col As Integer, i As Long
    Dim valeurs()

    NBesoin = "LCH-MYEL"

    Set cell = [N°B].Find(NBesoin): If cell Is Nothing Then Exit Sub
    VNBesoin = cell.Offset(, 1)
    NS = cell.Offset(, 2)

    nb_lig = Application.CountA(Feuil2.Columns(VNBesoin)): If nb_lig = 0 Then Exit Sub
    nb_col = Feuil3.UsedRange.Columns.Count
    ReDim valeurs(nb_lig, nb_col)

    With Feuil2
        Set cell = .Columns(VNBesoin).Find(VNBesoin): If cell Is Nothing Then Exit Sub
        Set cell1 = cell
        i = 0
        Do
            valeurs(i, 0) = .Cells(cell.Row, "M")
            valeurs(i, 1) = NS
            valeurs(i, 2) = .Cells(cell.Row, "E")
            valeurs(i, 3) = .Cells(cell.Row, "F")
            valeurs(i, 5) = .Cells(cell.Row, "J")
            valeurs(i, 11) = .Cells(cell.Row, "K")
            valeurs(i, 12) = .Cells(cell.Row, "L")
            i = i + 1
            Set cell = .Columns(VNBesoin).FindNext(cell)
        Loop Until cell.Address = cell1.Address
    End With

    With Feuil3
        Set cell = .Columns("A").Find("")
        cell.Resize(nb_lig, nb_col).Value = valeurs
    End With

End Sub

Bonsoir ,

Merci thev,

Dsl de repondre si tardivement, mais j'ai pas eu de vrai PC sous les doigts pour tester : Ton code fonctionne nickel, sauf qu'il ne ramene pas les erreurs du mien

Puis je revenir vers toi pour des éclaircissements si besoin?

Je valide

A+

edlede a écrit :

Puis je revenir vers toi pour des éclaircissements si besoin?

Bien sûr, sans problème.

A noter que l'emploi de la méthode Find de l'objet Range simplifie bien le code et que l'utilisation d'un tableau dynamique accélère le temps d'exécution.

Bonsoir thev,

j'ai pousser un peu plus loin mes investigations dans ton code, mais je butte encore sur un probleme lier a

NS = cell.Offset(, 2)

Dans l'exemple testé le secteur rapatrié est bien le bon car il n' y en a qu'un mais si on modifie le NBesoin en

NBesoin = "LCH-GBMHM"

on devrait rapatrier 9 secteurs différents, et actuellement il ramène systématiquement le premier secteur rencontré.

Dans mon ancien code je testais le deux premiers carctères de ma liste [N°S] ( les 2 premier digits représentent le numéro du besoin soit VNBesoin )

For Each SCel In [N°S]
            If Left(SCel.Value, 2) = VNBesoin Then

Je me bat avec cela depuis le début de l’après midi mais rien y fait, au mieux toute la colonne est vide

Si tu as une idée là je patauge,

Merci

Bonsoir,

C'est effectivement un peu plus complexe.

Je te resoumets la modification du code d'ici demain.

Bonsoir,

ci-jointe nouvelle version à tester

Merci thev,

Ton code reste encore un peu obscure mais il ramene les bonnez données, sauf pour le secteur ou il me faudrait l'intitulé du secteur plutôt que son numéro mais je pense qu'avec un offset-1sur la liste [N°S], on doit pouvoir recuperer la bonne donnée. Mais j'ai pas trouvé ou il fallait que je fasse la modif.

Si tu as encore un peu de temps à consacré à ce sujet je suis prenneur,

En tout cas un grand merci pour le travail déjà fait c'est super

Si j'ai bien compris ton code tu récupère ici les numéros de secteur

'détermination des colonnes de la feuille Produit et du nombre de lignes correspondant aux secteurs
    'et récupération des codes secteur et colonnes de secteurs dans le tableau des colonnes_secteur
    i = 0: nb_lig = 0
    ReDim colonnes_secteur(1, UBound(secteurs, 2))
    Application.FindFormat.Clear
    For Each NS In secteurs
        If NS Like VNBesoin & "*" Then code_secteur = NS: secteur = Empty _
        Else secteur = NS
        If secteur <> Empty Then
            With Prod
                Set cell = .Rows(1).Find(secteur, after:=.Range("V1")): If cell Is Nothing Then Exit Sub
                colonnes_secteur(0, i) = code_secteur: colonnes_secteur(1, i) = cell.Column:  i = i + 1
            nb_lig = nb_lig + Application.CountIf(Prod.Columns(cell.Column), code_secteur)
            End With
        End If
    Next NS

Mais je n'arrive toujours pas à stocker le nom du secteur sauf en refaisant une boucle sur la feuil3 qui convertie pour chaque code secteur le noms du secteur

'remplissage de la feuille Feuil3 à partir du tableau des valeurs
    With Feuil3
        Set cell = .Columns("A").Find("")
        cell.Resize(nb_lig, nb_col).Value = valeurs

        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row       
        For Each code In [N°S]
         If Cells(i, 2).Value = code.Value Then Cells(i, 2) = code.Offset(, -1)
         Next code
        Next i
    End With

Mais du coup je suis moin optimal

Bonjour,

Le plus simple est de remplacer les 2 tableaux intermédiaires par 2 collections de type dictionnaire ayant chacune pour clé le code secteur et pour contenu respectif le secteur et la colonne du secteur dans la feuille Produits.

D'ailleurs, ça simplifie le code et j'aurais dû opter pour cette option dès le départ.

ci-jointe version modifiée

Bonsoir Thev,

C'est du grand art (enfin pour moi)

J'essaie d’éplucher le code mais les prochaines opérations devraient être sur le même principe,

D'ailleurs, ça simplifie le code et j'aurais dû opter pour cette option dès le départ.

Faut dire que mon exemple initiale était trop simplifié pour avoir besoin du dictionnaire, j'ai beau essayer de l'utiliser comme un grand j'arrive jamais au bon résultat.

J'espères que je vais réussir à ré appliquer tout cela, c'est parfait pour moi encore bravo! Et MERCI

Bonsoir,

Pour faciliter ta compréhension, une explication de l'objet Dictionary.

L'objet Dictionary (créé par l'instruction CreateObject("Scripting.Dictionary")) est une collection d'éléments associée à une clé unique. Cette clé est en général une chaîne ou un entier.

Si par exemple, "dico1" est un objet Dictionary,

Les méthodes (actions) possibles sont :

dico1.Add - Ajoute une nouvelle paire clé/élément à l'objet

dico1.Exists - Renvoie une valeur de type Boolean qui indique si une clé spécifiée existe dans l’objet .

dico1.Items - Renvoie un tableau de tous les éléments de l'objet .

dico1.Keys - Renvoie un tableau de toutes les clés de l'objet .

dico1.Remove - Supprime la paire clé/élément spécifiée de l’objet .

dico1.RemoveAll - Supprime toutes les paires clé/élément de l’objet .

Les propriétés possibles sont :

dico1.Count - Renvoie le nombre de paires clé/élément dans l'objet .

dico1.Item - Définit ou renvoie la valeur d’un élément de l'objet par son indice : dico1.item(i) ou dico1(i)

dico1.Key - Définit ou renvoie la valeur d’un élément de l'objet par sa clé : dico1.key(clé) ou dico1(clé)

NB: A noter que si clé1 n'existe pas, l'instruction dico1(clé1) = élément1 est équivalente à l'instruction dico1.Add clé1, élément1

oui effectivement c'est nickel je valide et un grand merci !