XL 2016 Optimisation de code macro

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Makovitch

XLDnaute Nouveau
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
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
84
Réponses
4
Affichages
364
Réponses
7
Affichages
108
Réponses
0
Affichages
381
Réponses
1
Affichages
468
Retour