Macro de comparaison et de tri

Bonjour à touts et à tous,

Désolé de vous déranger en période de fin d'année, je me débrouille sur excel mais pas du tout en Macro. Hors je pense que pour obtenir le résultat souhaité je n'ai pas d'autre alternative que la macro.

Sur un fichier pouvant contenir 50.000 lignes, je souhaiterai que la macro, fasse le comparatif de toutes les références et me dise référence "X" en stock mort sur la ville "y" mais la référence "x" est en stock "vivant sur la ville "z".

Tout en intégrant une notion de coût et de date de dernière vente.

Je vous joint un modèle test.

Merci par avance de votre aide

Bonjour,

peux-tu donner une exemple concret ? quelles seraient les données que tu introduirais et quels résultats attendrais-tu selon qu'il s'agisse d'un stock mort ou vivant ?

Bonjour h2so4,

Je viens de modifier le fichier en feuille 2 le résultat attendu.

Merci

bonjour,

une proposition, j'ai compris que tu introduisais la référence, la ville morte et la ville vivante en feuil2 et que la macro devait trouver la valeur du stock mort à transferer ainsi que la date de la dernière vente du stock vivant.

Sub aargh()
    Set ws = Sheets("feuil2")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        Set pl = .Range("B1:B" & dl)
        Set re = pl.Find(ws.Range("A2"), lookat:=xlWhole)
        If Not re Is Nothing Then
            fa = re.Address
            mort = False
            vivant = False
            Do
                If re.Offset(, -1) = ws.Range("B2") Then
                    mort = True
                    ws.Range("E2") = re.Offset(, 4)
                ElseIf re.Offset(, -1) = ws.Range("C2") Then
                    vivant = True
                    ws.Range("D2") = re.Offset(, 6)
                End If
                Set re = pl.FindNext(re)
            Loop Until (mort And vivant) Or re.Address = fa
        End If
    End With
End Sub

Excuse moi j'ai du mal m'exprimer

En fait, je souhaite que la macro fasse les opérations suivantes :

1- vérifier les références de la feuille 1 et copier la référence sur la feuille 2 si cette référence est présente sur au moins 2 villes et si elle morte sur une et vivante sur l'autre.

2- une fois la référence copier, j'aimerais que les villes correspondantes au stock mort et vivant soit copier dans les colonnes respectives

3- Que l'information de date de dernière sortie de la ville stock vivant soit copier sur la feuille 2

4- Que le montant du PAMP de la ville ou le stock est mort soit copier sur la feuille 2.

Bonjour,

et que faut-il faire s'il y a plusieurs villes mortes ou plusieurs villes vivantes pour la même référence ?

Dans ce cas là il faut afficher toutes les villes avec stocks mort et afficher la ville ayant la dernière date de vente la plus proche du jour de lancement de la macro.

bonjour,

une nouvelle proposition

Sub aargh()
    Set ws = Sheets("feuil2")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Columns(1).Insert shift:=xlToRight
        .Range("A1") = 1
        .Range("A2") = 2
        .Range("A1:A2").AutoFill Destination:=.Range("A1:A" & dl)
        .Range("A1:I" & dl).Sort key1:=.Range("C1"), order1:=xlAscending, key2:=.Range("I1"), order2:=xlDescending, Header:=xlYes
        pr = ""
        k = 1
        For i = 2 To dl + 1
            If .Cells(i, 3) <> pr Then
                If pr <> "" Then
                    If kv <> 0 Then
                        For j = fk To k
                            ws.Cells(j, 3) = .Cells(kv, 2)
                            ws.Cells(j, 4) = .Cells(kv, 9)
                        Next j
                    Else
                        ws.Rows(fk & ":" & k).ClearContents
                        k = fk - 1
                    End If
                End If
                kv = 0
                pr = .Cells(i, 3)
                fk = k + 1
            End If
            Select Case .Cells(i, 8)
            Case "+ 24 Mois", "de 12 à 24 Mois"
                k = k + 1
                ws.Cells(k, 1) = pr
                ws.Cells(k, 2) = .Cells(i, 2)
                ws.Cells(k, 5) = .Cells(i, 7)
            Case Else
                If kv = 0 Then kv = i
            End Select
        Next i
        .Range("A1:I" & dl).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
        .Columns(1).Delete shift:=xlToLeft
    End With
End Sub

Merci pour cette Macro cela fonctionne à la perfection.