Stopper l'exécution si condition remplit

aba2s

XLDnaute Junior
Bonjour la communauté,

J'ai développé une macro qui marche comme je le souhaiterai sauf qu'elle se met à s'exécuter à chaque fois qu'on l'exécute.
Il ne devrait pas y avoir de doublons aux colonnes H, I et J. La macro ne doit s'exécuter qu'une seule fois pour chaque valeur en B2.

Merci pour votre aide
VB:
Sub RepartitionDSP()
Application.ScreenUpdating = False
' Cette macro remplit la répartion de chaque campagne sur les différents DSP
s = 0
Dim dsp, entete As Range
Set entete = Sheets("Info").Cells.Find(what:="Vendor Name")
derL = Sheets("Info").Cells(entete.Row, entete.Column).CurrentRegion.Rows.Count - 1
For Each dsp In Sheets("Info").Range("J1:J3")
If dsp <> "" And Range("B2").Value <> "" Then
s = s + 1
'Vendor Name
Sheets("Info").Cells(entete.Row + derL + s, entete.Column) = dsp
'Budget
Sheets("Info").Cells(entete.Row + derL + s, entete.Column + 1) = dsp.Offset(, 1)
'Insertion Order
Sheets("Info").Cells(entete.Row + derL + s, entete.Column + 2) = Range("B2").Value
End If
Next dsp

End Sub
 

Pièces jointes

  • Doublons.xlsm
    21 KB · Affichages: 7
Dernière édition:

eriiic

XLDnaute Barbatruc
Bonjour,

sauf qu'elle se met à s'exécuter à chaque fois qu'on l'exécute
C'est heureux, c'est bien comme ça que le fonctionnement est prévu.
Par contre, si elle supprime des choses qu'elle ne devrait pas, c'est donc qu'elle ne marche pas vraiment comme souhaité.

Comme de toute façon ton fichier n'a rien en B et aucun doublon en H, I, J, et rien d'autre qu'une macro erronée pour essayer te comprendre un peu mieux, je passe la main.
Allez, next :)
eric
 

eriiic

XLDnaute Barbatruc
A tester :
VB:
Sub RepartitionDSP()
    Dim datas, lig As Long
    Application.ScreenUpdating = False
    ' Cette macro remplit la répartion de chaque campagne sur les différents DSP
    s = 0
    Dim dsp, entete As Range
    Set entete = Sheets("Info").Cells.Find(what:="Vendor Name")
    derL = Sheets("Info").Cells(entete.Row, entete.Column).CurrentRegion.Rows.Count - 1
    For Each dsp In Sheets("Info").Range("J1:J3")
        If dsp <> "" And Range("B2").Value <> "" Then
            datas = Intersect([B7].CurrentRegion, Range("H:J"))
            For lig = 1 To UBound(datas)
                ok = datas(lig, 1) = dsp And datas(lig, 2) = dsp.Offset(, 1) And datas(lig, 3) = Range("B2").Value
                If ok Then Exit For
            Next lig
            If Not ok Then
                s = s + 1
                'Vendor Name
                Sheets("Info").Cells(entete.Row + derL + s, entete.Column) = dsp
                'Budget
                Sheets("Info").Cells(entete.Row + derL + s, entete.Column + 1) = dsp.Offset(, 1)
                'Insertion Order
                Sheets("Info").Cells(entete.Row + derL + s, entete.Column + 2) = Range("B2").Value
            End If
        End If
    Next dsp
End Sub
eric
 

Discussions similaires

Statistiques des forums

Discussions
312 169
Messages
2 085 914
Membres
103 034
dernier inscrit
Mbeya