Associer une date à un client

[antgrandj]

Bonjour,

Je cherche à pouvoir sélectionner les commandes de clients qui ont été faites entre la première et maximum un an après. Le but étant de calculer le CA des nouveaux clients (= nouveau à la première commande jusqu'à 1 an après).

J'ai essayé de faire cela en mettant un "1" si la commande du client a été faite max 1 an après la première ou un "0" dans le cas contraire mais je n'arrive pas à associer les dates avec le numéro de client.

Peux-tu m'aider? Fichier en pièce-jointe.

Merci d'avance

 

[Robert]

Re : Associer une date à un client

Bonjour Antgrandj, bonjour le forum,

En pièce ton fichier modifié avec le code ci-dessous. Dans l'onglet CA sont affichées, par client, les lignes de la date de sa première commande à la ligne de la commande en date de (date + 1 an). Chaque client est séparé par une ligne blanche.
Le code :

Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELLule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim dd As Date 'déclare la variable dd (Date de Début)
Dim j As String 'déclare la variable j (Jour)
Dim m As String 'déclare la variable m (Mois)
Dim a As Integer 'déclare la variable a (Année)
Dim df As String 'déclare la variable df (Date de Fin)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)


Sheets("CA").Cells.ClearContents 'supprime les anciennes données de l'onglet "CA"
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
With Sheets("lrship 09 cust") 'prend en compte l'onglet "lrship 09 cust"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
    Set pl = .Range("A2:A" & dl) 'définit la plage pl
    Set dico = CreateObject("Scripting.Dictionary") 'e'finit la dictionnaire dico
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        dico(cel.Value) = "" 'alimente le dictionnaire dico
    Next cel 'prochaine cellule de la boucle
    temp = dico.keys 'récupère le dictionnnaire dico sans doublons dans le tableau temporaire temp
    For i = 0 To UBound(temp, 1) 'boucle sur tous les éléments uniques du tableau temp
        .Range("A1").AutoFilter 'lance le mode filtre automqtique
        .Range("A1").AutoFilter Field:=1, Criteria1:=temp(i) 'filre la colonne 1 (=A) avec temp(i) comme critère
        dd = pl.SpecialCells(xlCellTypeVisible).Offset(0, 1)(1).Value 'récupère la date de debut (première date des cellules visibles de la colonn B)
        j = CStr(Day(dd)) 'définit le jour j
        m = CStr(Month(dd)) 'définit le mois m
        a = Year(dd) + 1 'définit l'année a+1
        df = m & "/" & j & "/" & a 'définit la date de fin
        .Range("A1").AutoFilter Field:=2, Criteria1:="<=" & df 'filtre la colonne 2 (=B) avec "inférieur oou égal à la date de fin" comme critère
        Set dest = Sheets("CA").Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0) 'définit la cellule de destination dest
        On Error Resume Next 'gestion des erreurs (passe à la laigne suivante si une erreur est générée)
        pl.SpecialCells(xlCellTypeVisible).Resize(, 2).Copy dest 'copy la plage filtrée dans dest (génère une erreur si la plage fitrée est vide)
        If Err <> 0 Then Err = 0 'si une erreur a été générée, annule l'erreur
        On Error GoTo 0 'annule la gestion des erreurs
        .Range("A1").AutoFilter 'termine le mode filtre automatique (et donc réaffiche tout)
    Next i 'prochain élément de la boucle
End With 'fin de la prise en compte de l'onglet "lrship 09 cust"
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Les données ont été traitées avec succès !" 'meesage de fin
Sheets("CA").Select 'sélectionne l'onglet "CA"
End Sub

Le fichier :

 

[antgrandj]

Re : Associer une date à un client

Merci, c'est très gentil.

Le problème est que je ne comprends rien aux macros (niveau basique en Excel) et que mon fichier sur lequel je dois travailler n'est pas le même que celui que j'avais envoyé. Il y a d'autres colonnes et a beaucoup plus de lignes. La colonne A et B dans l'exemple sont respectivement les colonnes D et H dans mon fichier.

Du coup, je ne sais pas trop comment procéder.

 

[Robert]

Re : Associer une date à un client

Bonjour Angrandj, bonjour le forum,

Mais est-ce que l'idée de convient ? Si oui, on pourrait adapter à ton fichier.
Ou bien, as-tu seulement besoin de la date + 1 an ? On pourrait la colorer en rouge sur le tableau d'origine...

 

[antgrandj]

Re : Associer une date à un client

En fait, ce que je voulais, c'était créer un colonne supplémentaire et y trouver un "1" si ça fait moins d'un an entre la date du premier achat et celle de la ligne correspondante ou trouver un "0" dans le cas contraire. Après, il me suffit de supprimer toute les lignes avec des 0 qui ne m'intéresse pas. Le problème c'est que je ne sais pas comment lier la colonne date à chaque client.

L'idée de la macro est surement très bonne mais sans doute trop compliquée pour moi ;-)

 

[Dugenou]

Re : Associer une date à un client

Bonjour antgrandj, Bonjour Robert,
Une solution avec une formule matricielle (des {} apparaissent autour de la formule : il faut valider avec la combinaison des 3 touches ctrl+maj (la fleche, pas le cadenas)+enter
Cordialement

 

[antgrandj]

Re : Associer une date à un client

Grand merci Dugenou! C'est bien ce que je voulais.

Merci aussi à Robert pour avoir essayé de m'aider.

A bientot!

 

[Robert]

Re : Associer une date à un client

Bonjour Antgrandj, bonjour le forum,

Une nouvelle proposition VBA adaptée en version 02. Les dates sont colorées de rouge...
Le code:

Public Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELLule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim dd As Date 'déclare la variable dd (Date de Début)
Dim df As String 'déclare la variable df (Date de Fin)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
With Sheets("lrship 09 cust") 'prend en compte l'onglet "lrship 09 cust"
    .Columns(8).Interior.ColorIndex = xlNone 'supprime la couleur rouge
    dl = .Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 4 (=D)
    Set pl = .Range("D2:D" & dl) 'définit la plage pl
    Set dico = CreateObject("Scripting.Dictionary") 'e'finit la dictionnaire dico
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        dico(cel.Value) = "" 'alimente le dictionnaire dico
    Next cel 'prochaine cellule de la boucle
    temp = dico.keys 'récupère le dictionnnaire dico sans doublons dans le tableau temporaire temp
    For i = 0 To UBound(temp, 1) 'boucle sur tous les éléments uniques du tableau temp
        Set r = pl.Find(temp(i), .Cells(dl, 4), xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 1 : si il il existe au moins une occurrence trouvée
            pa = r.Address 'définit l'adresse dela première occurrence
            dd = r.Offset(0, 4).Value 'récupère la date de début
            r.Offset(0, 4).Interior.ColorIndex = 3 'colore la date de début de rouge
            Do 'exécute
                If r.Offset(0, 4).Value < dd + 365 Then 'condition 2 : si la date de l'occurrence trouvée est inférieure à la date de début + 365 jours
                    df = r.Offset(0, 4).Value 'définit la date de fin
                    r.Offset(0, 4).Interior.ColorIndex = 3 'colore la date de l'occurrence trouvée de rouge
                Else 'sinon (condition 2)
                    Exit Do 'sort de la boucle do... Loop
                End If 'fin de la condition 2
                Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles ouccurrences ailleurs qu'en pa
        End If 'fin de la condition 1
    Next i 'prochain élément de la boucle
End With 'fin de la prise en compte de l'onglet "lrship 09 cust"
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Les données ont été traitées avec succès !" 'meesage de fin
End Sub

Le fichier :

[Édtion]
Ooops ! trop tard...