XL 2016 Optimisation de code macro

Makovitch · 9 Septembre 2020

Bonjour à tous,
j'ai besoin d'aide concernant ma macro, qui commence à être assez lourde...
Je souhaite, à travers plusieurs conditions, rechercher à partir de la feuille 2 une valeur si :
1) ma cellule est vide
2) le pays correspond sur les deux feuilles
je vous mets mon code ci-dessous pour mieux comprendre
Mon code fonctionne correctement mais j'aimerai juste avoir une aide pour le simplifier

Merci !

Sub test()

Dim fl As Integer, j, i As Integer, dl As Integer

With Sheets("Feuil11")

fl = .Range("G" & Rows.Count).End(xlUp).Row

For j = 5 To fl

If .Range("G" & j).Value = "" And .Range("C" & j).Value = "BELGIUM" Then

.Range("G" & j).Value = Worksheets("Feuil2").Range("F6").Value

.Range("G" & j).Interior.ColorIndex = 45

ElseIf .Range("G" & j).Value = "" And .Range("C" & j).Value = "GERMANY" Then

.Range("G" & j).Value = Worksheets("Feuil2").Range("F10").Value

.Range("G" & j).Interior.ColorIndex = 45

ElseIf .Range("G" & j).Value = "" And .Range("C" & j).Value = "IRELAND" Then

.Range("G" & j).Value = Worksheets("Feuil2").Range("F20").Value

.Range("G" & j).Interior.ColorIndex = 45

ElseIf .Range("G" & j).Value = "" And .Range("C" & j).Value = "ITALY" Then

.Range("G" & j).Value = Worksheets("Feuil2").Range("F22").Value

.Range("G" & j).Interior.ColorIndex = 45

ElseIf .Range("G" & j).Value = "" And .Range("C" & j).Value = "PORTUGAL" Then

.Range("G" & j).Value = Worksheets("Feuil2").Range("F28").Value

.Range("G" & j).Interior.ColorIndex = 45

End If

Next j

End With

End Sub

sylvanu · 9 Septembre 2020

Bonjour Makovitch,
Déjà, lorsque vous donnez du code, essayez d'utiliser les balises ( </> à droite du smiley ); C'est plus lisible et immédiatement copiable.
Ci dessous une approche avec Case, qui dans votre exemple peut simplifier l'écriture. Le recours à Set permet aussi de simplifier les choses. ( et n'oubliez pas l'indentation, c'est plus lisible )
Par contre, non testé. Il serait bon de fournir un petit fichier test, ce qui garantit le bon fonctionnement car la macro serait testée :

Code:

Sub test()
Dim fl As Integer, j, i As Integer, dl As Integer, ws
Set ws = Worksheets("Feuil2")
With Sheets("Feuil11")
    fl = .Range("G" & Rows.Count).End(xlUp).Row
    For j = 5 To fl
        If .Range("G" & j) = "" Then
            .Range("G" & j).Interior.ColorIndex = 45
            Select Case .Range("C" & j)
                Case "BELGIUM"
                    .Range("G" & j) = ws.Range("F6")
                Case "GERMANY"
                    .Range("G" & j) = ws.Range("F10")
                Case "IRELAND"
                    .Range("G" & j) = ws.Range("F20")
                Case "ITALY"
                    .Range("G" & j) = ws.Range("F22")
                Case "PORTUGAL"
                    .Range("G" & j) = ws.Range("F28")
            End Select
        End If
    Next j
End With
End Sub

sylvanu · 9 Septembre 2020

Or just for the fun ...
En utilisant un array. Si le nombre de pays est grand, c'est surement le plus simple.
Quand on ajoute un pays, on ne touche pas au code, on enrichit simplement l'array.
( toujours pas testé )

VB:

Sub test2()
Dim fl As Integer, j, i As Integer, dl As Integer, ws, tablo
' tablo est constitué de N couples : "Pays","Cellule"
tablo = Array("BELGIUM", "F6", "GERMANY", "F10", "IRELAND", "F20", "ITALY", "F22", "PORTUGAL", "F28")
Set ws = Worksheets("Feuil2")
With Sheets("Feuil1")
    fl = .Range("G" & Rows.Count).End(xlUp).Row
    For j = 5 To fl
        If .Range("G" & j) = "" Then
            For k = 0 To UBound(tablo) Step 2
                If .Range("C" & j) = tablo(k) Then
                    .Range("G" & j) = ws.Range(tablo(k + 1))
                    .Range("G" & j).Interior.ColorIndex = 45
                End If
            Next k
        End If
    Next j
End With
End Sub

Makovitch · 9 Septembre 2020

Bonjour Sylvanu, merci beaucoup j'essaye de suite et je reviens vers toi

Makovitch · 9 Septembre 2020

C'est parfait, encore merci à toi !

XL 2016 Optimisation de code macro

Makovitch

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Makovitch

XLDnaute Nouveau

Makovitch

XLDnaute Nouveau

Discussions similaires