Optimisation de code

Le 18/03/2020 à 11:33

Bonjour

Je n'ai pas un très grand niveau en vba, allant de bidouillage en copier / coller d'internet avec adaptation à mon fichier.

J'ai une fonction qui me permets de copier les valeurs d'une cellule de la colonne D dans la cellule de la colonne E si la cellule de destination est vide. Puis supprimer la colonne D fait et de répeter cette opération 6 fois.

Ce que j'ai fait, c'est recopier 6 fois la fonction, ce qui n'est pas optimal.

Voici mon code

' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 5eme colonne (E) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

Comment je pourrais optimiser mon code pour ne pas dupliquer mon code 6 fois.

Idéalement je voudrais pouvoir rejouer ce code jusqu'à ce qu'il n'y ai plus que des cellules vides dans la colonne E.

Merci à tous pour votre aide

Le 18/03/2020 à 11:54

Salut cendre et

cendre a écrit :
et de répeter cette opération 6 fois.
Comment je pourrais optimiser mon code pour ne pas dupliquer mon code 6 fois.
Idéalement je voudrais pouvoir rejouer ce code jusqu'à ce qu'il n'y ai plus que des cellules vides dans la colonne E.

pourquoi 6 fois? peut on voir le code complet avec les 6 répétitions?

à vous relire!

Le 18/03/2020 à 11:57

Pourquoi 6 fois ? Parce que pour le moment, j'ai des cellules non vides dans les 6 colonnes suivantes

Voici le code tel que je l'ai

' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

    ' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

    ' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

    ' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

    ' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

    ' Copie Colle les valeurs de sprint dans la case de sprint suivant
    For i = 2 To 300
        'Si la cellule de la ligne i et de la 4eme colonne (D) est égale à vide, alors
        If Cells(i, 5) = "" Then
            'La valeur de la cellule de la ligne i et de la colonne 4 (D) est recopié sur la même ligne i en colonne 5 (E)
            Cells(i, 5).Value = Cells(i, 4).Value
        'Fin de la condition If
        End If
    'Fin de la boucle For
    Next

' Supprimer la colonne D
    Columns("D:D").Delete Shift:=xlToLeft

Comme vous pouvez le voir, c'est 6 fois exactement la meme chose

Le 18/03/2020 à 12:13

Bonjour,

Une macro commence par Sub et se termine par End Sub

Elle est étroitement dépendante de son module, (module de feuille ou Module standard) et bien entendu de la feuille cible elle-même.

Pour cette raison il faut joindre le classeur et la feuille KIVABIEN avec. (surtout pour une optimisation !)

A+

Le 18/03/2020 à 12:16

Re,

galopin a raison!

voici une macro test

Sub test()
Dim ws As Worksheet

Set ws = ThisWorkbook.ActiveSheet
For i = 2 To 300
    ws.Cells(i, 4).Value = ws.Cells(i, Columns.Count).End(xlToLeft).Value
Next i
Columns("E:J").Delete Shift:=xlToLeft
End Sub

2cendre.xlsm (20.47 Ko)

@+++

Le 18/03/2020 à 12:32

Bonjour à tous, et merci pour vos retours

galopin01 a écrit :
Bonjour,
Une macro commence par Sub et se termine par End Sub
Elle est étroitement dépendante de son module, (module de feuille ou Module standard) et bien entendu de la feuille cible elle-même.
Pour cette raison il faut joindre le classeur et la feuille KIVABIEN avec. (surtout pour une optimisation !)
A+

Voici le code au global

Sub suivi_epic()
'
' suivi_epic Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+F
' Séparation du CSV
Range("A1:A200").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False
' Supprimer les colonne en trop (on ne garde que Status, Epic link, SP, Sprint)
Dim j As Long
For j = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
Select Case Cells(1, j)
Case "Status", "Custom field (Story Points)", "Custom field (Epic Link)", "Sprint"
Case Else
Columns(j).Delete
End Select
Next
' Remplacer les ".0" par rien
Range("A2:E200").Select
Cells.Replace What:=".0", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Remplacer les "0.5" par "0,5"
Range("A2:E200").Select
Cells.Replace What:=".5", Replacement:=",5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Remplacer les numéro d'épic par leur noms
Range("A2:E200").Select
Cells.Replace What:="ETAM-9628", Replacement:="Panier", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9629", Replacement:="Formulaire", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9633", Replacement:="Identification", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9241", Replacement:="Shipping", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9643", Replacement:="Paiement", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9631", Replacement:="Confirmation", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9745", Replacement:="Header", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9746", Replacement:="Catégorie", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9744", Replacement:="Produit", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9242", Replacement:="Homepage", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9632", Replacement:="Transverse", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="ETAM-9870", Replacement:="UI", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'remplace les status
Cells.Replace What:="Backlog", Replacement:="Dev", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="To Do", Replacement:="Dev", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="In progress", Replacement:="Dev", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="PR Under review", Replacement:="Dev", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Pending", Replacement:="Bloqué", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Additional information required", Replacement:="Bloqué", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Q.A.T", Replacement:="Test", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="QAT SB", Replacement:="Test", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="U.A.T", Replacement:="Test", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="waiting for QAT sur dev", Replacement:="OK", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="To release", Replacement:="OK", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Released", Replacement:="OK", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Closed", Replacement:="OK", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Remplacer les "sprint" par rien
Range("A2:E300").Select
Cells.Replace What:="Sprint", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Remplacer les "valeurs des sprint" par rien
Range("A2:E300").Select
Cells.Replace What:="/*.20-**/**-**", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A2:E300").Select
Cells.Replace What:=".20-**/**-**", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A2:E300").Select
Cells.Replace What:="11.19-10/07-10", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
' Copie Colle les valeurs de sprint dans la case de sprint suivant
For i = 2 To 300
'Si la cellule de la ligne i et de la 4eme colonne est égale à vide, alors
If Cells(i, 5) = "" Then
'La valeur de la cellule de la ligne i et de la colonne 4 est recopié sur la même ligne i en colonne 5 (E)
Cells(i, 5).Value = Cells(i, 4).Value
'Fin de la condition If
End If
'Fin de la boucle For
Next
' Supprimer la colonne D
Columns("D:D").Delete Shift:=xlToLeft
'' création du bloc des status
Cells(2, 6) = "Dev"
Cells(3, 6) = "Test"
Cells(4, 6) = "OK"
Cells(5, 6) = "Bloqué"
' création bloc epic
Cells(2, 9) = "Panier"
Cells(3, 9) = "Formulaire"
Cells(4, 9) = "Identification"
Cells(5, 9) = "Shipping"
Cells(6, 9) = "Paiement"
Cells(7, 9) = "Confirmation"
Cells(8, 9) = "Header"
Cells(9, 9) = "Catégorie"
Cells(10, 9) = "Produit"
Cells(11, 9) = "Homepage"
Cells(12, 9) = "Transverse"
Cells(13, 9) = "UI"
' création bloc calcul
Cells(1, 10) = "OK"
Cells(1, 11) = "Test"
Cells(1, 12) = "En cours"
Cells(1, 13) = "prochain sprint"
Cells(1, 14) = "Bloqué"
Cells(2, 10).Select
ActiveCell.Formula = _
"=SumIfs(B$2:B300,C$2:C300,I2,A$2:A300,F$4)"
Selection.AutoFill Destination:=Range("J2:J13"), Type:=xlFillDefault
Cells(2, 11).Select
ActiveCell.Formula = _
"=SumIfs(B$2:B300,C$2:C300,I2,A$2:A300,F$3)"
Selection.AutoFill Destination:=Range("K2:K13"), Type:=xlFillDefault
Cells(2, 12).Select
ActiveCell.Formula = _
"=SumIfs(B$2:B300,C$2:C300,I2,A$2:A300,F$2,D$2:D300,'Donnees sprint'!D$23)"
Selection.AutoFill Destination:=Range("L2:L13"), Type:=xlFillDefault
Cells(2, 13).Select
ActiveCell.Formula = _
"=SumIfs(B$2:B300,C$2:C300,I2,A$2:A300,F$2)-L2"
Selection.AutoFill Destination:=Range("M2:M13"), Type:=xlFillDefault
Cells(2, 14).Select
ActiveCell.Formula = _
"=SumIfs(B$2:B300,C$2:C300,I2,A$2:A300,F$5)"
Selection.AutoFill Destination:=Range("N2:N13"), Type:=xlFillDefault
'copier le tableau de valeur dans la page correspondante
Range("I1:N13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("données chiffré").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Et voici le fichier

9epics-de-la-refonte-jira-2020-03-17t11-28-58-0100.zip (8.94 Ko)

Le 18/03/2020 à 21:42

Bonjour,

Ton fichier optimisé.

Il subsiste un petit désagrément du à la liaison (il suffit d'annuler ou de supprimer la liaison) mais cette erreur n'est pas bloquante. La macro se termine correctement.

A+

9epics-de-la-refonte-vg.xlsm (33.48 Ko)

Le 19/03/2020 à 10:42

Whaou, merci Galopin01, c'est tellement plus léger et optimisé comme ca

Par contre je t'avoue que j'ai essayé de comprendre un peu ton code... mais j'ai clairement pas le niveau.

Peux tu m'expliquer ce passage ?

On Error GoTo GESTERR
   For i = 2 To k
      ii = Cells(i, Columns.Count).End(xlToLeft).Column
      If ii > 3 Then Cells(i, 4).Value = Cells(i, Columns.Count).End(xlToLeft).Value
   Next i
Columns("E:J").Delete Shift:=xlToLeft

De ce que je pense comprendre, pour chaque cellule comprise entre la ligne i (qui va de 2 à k, k étant la le nombre de ligne maximum ayant une valeur présente), il va checker la cellule d'après (ii) et si celle ci n'est pas vide, il y inscrit la valeur de la cellule i, puis il passe à la suivante. A la fin, on selectionne les colonne E à J, que l'on supprime.

C'est bien ca ?

A quoi correspond le On Error GoTo GESTERR ?

Merci pour tout

Le 19/03/2020 à 11:54

Bonjour,

Ce code est celui proposé par m3ellem1.

C'est en effet le meilleur moyen d'éviter toutes ces boucles.

...mais il produisait une erreur quand la colonne 4 est vide.

C'est pourquoi j'ai inséré cette gestion d'erreur (baclée )

Il conviendrait de la préciser un peu si tu développes un petit peu la suite, car cette gestion d'erreur reste active.

A minima tu pourrais modifier comme suit afin de mettre en évidence une autre erreur potentielle.

On Error GoTo GESTERR
   For i = 2 To k
      ii = Cells(i, Columns.Count).End(xlToLeft).Column
      If ii > 3 Then Cells(i, 4).Value = Cells(i, Columns.Count).End(xlToLeft).Value
   Next i
On Error GoTo 0
Columns("E:J").Delete Shift:=xlToLeft

... Mais je n'ai pas testé l'incidence si on ajoute cette précaution.

Ok ?

Rechercher des sujets similaires à "optimisation code"