Code VBA incrémentiel

Version imprimable

25/09/2017, 21h08
Nomorerulz

Code VBA incrémentiel

Bonjour,

Je cherche une manière, par VBA, d'associer des valeurs en fonction de certains critères prédéterminés.
J'ai un extrait de donnée provenant de SAP avec :

Feuille 1 : Shipping
- Colonne A : SKU (plusieurs doublons)
- Colonne B : État d'envoie (plusieurs doublons)
- Colonne C : Quantité disponible
- Colonne D : Critère (1 ou 0)

Feuille 2 : Data
- Colonne A : SKU (sans doublons)
- Colonne B : Quantité à envoyer

J'aimerais trouver comment faire un code VBA qui attribuera, dans une nouvelle colonne (E) de la feuille "Shipping", une valeur qui totalisera un maximum de ce qui se trouve dans la colonne B de la feuille "Data" (Quantité à envoyer), mais la valeur doit être ajoutée seulement si le critère de la colonne D de la feuille "Shipping" est égal à "1".

Par exemple, je peux retrouver:

Feuille 1 : Shipping (en gras, la nouvelle colonne)

0001RDL00 NY 2 1 2
0001RDL00 NY 1 1 1
0001RDL00 NY 3 1 2
0001RDL00 NJ 2 0 0
0001RDL00 NY 1 1 0
0001RDL00 NY 1 1 0
...

Feuille 2 : Data

0001RDL00 5
...

Il faut donc que lorsqu'il y a un "1" dans la 4e colonne, un nombre soit entré dans la nouvelle colonne jusqu'à ce que la somme totale pour ce SKU soit de "5" (indiqué dans la deuxième feuille) pour ce SKU précis. Une fois le total atteint, il faut indiquer "0" même si la 4e colonne indique "1".

Il y a une liste de SKU avec les quantités respectives dans la deuxième feuille.

Merci beaucoup d'avance! N'hésitez pas si vous avez besoin de plus de détails

Bonjour,

Quelque chose comme ça peut-être ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
    Dim I As Long, J As Long, Qte As Long
    Dim Code As String
    Dim nLignesData As Long, nLignesShip As Long
 
    nLignesData = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
    nLignesShip = Sheets("Shipping").Cells(Rows.Count, "A").End(xlUp).Row
 
    With Sheets("Data")
        For I = 2 To nLignesData
            Code = .Range("A" & I)
            Qte = .Range("B" & I)
 
            With Sheets("Shipping")
                For J = 2 To nLignesShip
                    If .Range("A" & J) = Code And .Range("D" & J) = 1 Then
                        If Qte > 0 Then
                            .Range("E" & J) = .Range("C" & J)
                            Qte = Qte - .Range("C" & J)
                        Else
                            Exit For
                        End If
                    End If
                Next
            End With
        Next
    End With

26/09/2017, 09h12
Menhir

Citation:

Envoyé par Nomorerulz

J'aimerais trouver comment faire un code VBA qui attribuera, dans une nouvelle colonne (E) de la feuille "Shipping", une valeur qui totalisera un maximum de ce qui se trouve dans la colonne B de la feuille "Data" (Quantité à envoyer), mais la valeur doit être ajoutée seulement si le critère de la colonne D de la feuille "Shipping" est égal à "1".

Désolé mais même en regardant ton exemple, je ne parviens pas à comprendre la logique de ton calcul, en particulier le rôle de la colonne C de "Shipping".
Parce que tu ne dis rien de cette colonne dans l'explication de ton calcul mais ton exemple laisse à penser qu'elle intervient puisque c'est la seule différence entre les lignes 1 et 2 qui ont des résultats différents.

Bonjour à tous,

Ci-dessous une variante basée sur le code proposé par parmi, afin d'éviter de dépasser la quantité maximale disponible et de ne passer qu'une seule fois sur chaque ligne (moyennant l'utilisation d'une référence à Microsoft Scripting Runtime) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
    Dim QteDict As New Scripting.Dictionary
    Dim Lin As Long, Code As String, Qte As Long
    Lin = 2
    With Sheets("Data")
        Do While .Cells(Lin, 1).Value <> ""
            QteDict.Add .Cells(Lin, 1).Value, .Cells(Lin, 2).Value
            Lin = Lin +1
        Loop
    End With
    Lin = 2
    With Sheets("Shipping")
        Code = .Cells(Lin, 1).Value
        Do While Code <> ""
            If .Cells(Lin, 4).Value = 1 Then
                Qte = Application.WorksheetFunction.Max(QteDict(Code), 0)
                .Cells(Lin, 5).Value = Qte
                QteDict(Code) = QteDict(Code) - Qte
            End If
            Lin = Lin +1
            Code = .Cells(Lin, 1).Value
        Loop
    End With