Tableau test date avec message groupé

Version imprimable

Bonjour j'ai un problème à traiter en VBA mais je ne sais pas comment m'y prendre.

J'ai un tableau Excel ressemblant à ceci:

Il y a des Réf qui proviennent parfois de plusieurs fournisseur.
Il y a des dates qui arrivent à échéance

Réf Fournisseur e-mail Date CDC Date FT Date REV

MP026 riri riri@fournis.om.com 06/01/2016 16/01/2016 19/01/2016

MP027 fifi fifi@fournis.om.com 07/01/2016 17/01/2016 20/01/2016

MP028 loulou loulou@fournis.om.com 08/01/2016 18/01/2016 21/01/2016

MP029 lulu lulu@fournis.om.com 09/01/2016 19/01/2016 22/01/2016

MP030 popo popo@fournis.om.com 10/01/2016 20/01/2016 23/01/2016

MP031 jiji jiji@fournis.om.com 11/01/2016 06/01/2016 24/01/2016

MP032 huhu huhu@fournis.om.com 12/01/2016 22/01/2016 25/01/2016

MP033 bobo bobo@fournis.om.com 13/01/2016 23/01/2016 07/01/2016

MP034 popo popo@fournis.om.com 14/01/2016 24/01/2016 27/01/2016

MP035 momo momo@fournis.om.com 15/01/2016 25/01/2016 28/01/2016

MP036 momo momo@fournis.om.com 16/01/2016 26/01/2016 29/01/2016

J'aimerai réer des alertes quand une date arrive à échéance de la façon suivante:

Faire un seul MsgBox par fournisseur disant par exemple:

- riri MP026 délai CDC arrive à échéance

ou

- jiji MP031 délai FT arrive à échéance

ou

- momo MP035 délai CDC arrive à échéance
MP036 délai CDC arrive à échéance
délai FT arrive à échéance

Voici ce que j'ai commencé mais ce n'est pas concluant car il y a des erreurs que je comprends pas et surtout je ne sais pas comment faire en sorte de ne pas traiter 2 fois la même alerte. (exemple de popo)
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 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 Sub ComptIdentique() Dim Email As String Dim DernLigne As Long Dim T_date Dim Message As String Dim MessageCDC As String Dim MessageFT As String Dim MessageREF As String Dim DateCDC As String Dim DateFT As String Dim DateREV As String Dim Ref As String Dim i As Integer Dim j As Integer Dim PlageEmail As Range Dim prec As String Dim Delai As Integer Dim Année As Integer Set PlageEmail = Worksheets("feuil1").Range("C1: C65000 ") T_date = Date Année = 3 'ans Delai = Année * 365 DernLigne = Range("C1048576").End(xlUp).Row For i = 1 To DernLigne Email = Range("C1").Offset(i).Value For j = 1 To DernLigne Ref = Range("A1").Offset(j).Value DateCDC = Range("F1").Offset(j).Value DateFT = Range("H1").Offset(j).Value DateREV = Range("J1").Offset(j).Value If Range("C1").Offset(j).Value = Email Then If T_date - Delai > DateCDC Then MessageCDC = " délai CDC " & DateCDC & " arrive à échéance" End If If T_date - Delai > DateFT Then MessageFT = " délai FT " & DateFT & " arrive à échéance" End If If T_date - Delai > DateREV Then MessageREV = " délai REV " & DateREV & " arrive à échéance" End If Message = Message & Ref & vbCrLf & MessageCDC & vbCrLf & MessageFT & vbCrLf & MessageREV & vbCrLf If Message <> "" Then MsgBox "Fournisseur " & Email & vbCrLf & vbCrLf & Message End If End If Next j Email = "" Message = "" Next i End Sub
Merci pour vos idées

Réf	Fournisseur	e-mail	Date CDC	Date FT	Date REV
MP026	riri	riri@fournis.om.com	06/01/2016	16/01/2016	19/01/2016
MP027	fifi	fifi@fournis.om.com	07/01/2016	17/01/2016	20/01/2016
MP028	loulou	loulou@fournis.om.com	08/01/2016	18/01/2016	21/01/2016
MP029	lulu	lulu@fournis.om.com	09/01/2016	19/01/2016	22/01/2016
MP030	popo	popo@fournis.om.com	10/01/2016	20/01/2016	23/01/2016
MP031	jiji	jiji@fournis.om.com	11/01/2016	06/01/2016	24/01/2016
MP032	huhu	huhu@fournis.om.com	12/01/2016	22/01/2016	25/01/2016
MP033	bobo	bobo@fournis.om.com	13/01/2016	23/01/2016	07/01/2016
MP034	popo	popo@fournis.om.com	14/01/2016	24/01/2016	27/01/2016
MP035	momo	momo@fournis.om.com	15/01/2016	25/01/2016	28/01/2016
MP036	momo	momo@fournis.om.com	16/01/2016	26/01/2016	29/01/2016

1 pièce(s) jointe(s)

Bonsoir
deux propositions pour le prix d'une seule !!! les soldes de fin d'année encore la :aie:
Voila une proposition avec un message pour chaque date CDC déja expirée ou bien arrive à échéance dans moins de 7 jours (tu peux bien sure adapter à tes besoins
Mais si vous avez beaucoup des dates et vous risquez d'oublier ces messages d'alertes ... je propose d'envoyer dans une nouvelle feuilles les échéances à moins de 7 jours (Date CDC prise en compte)
J'espère que ça t'aide à développer une petite solution adéquate à la situation chez vous
Bonne fin journée

avec message

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub alerte()
Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim j As Integer
Set w1 = Worksheets("feuil1") 'Feuille qui contient les alertes
D = Date
' ********************************* Période d'éssai
For i = 2 To w1.Range("D" & Rows.Count).End(xlUp).Row
p = D - w1.Range("D" & i)
If p >= 0 Then MsgBox ("La date CDC pour  " & Cells(i, "A").Value & "   " & Cells(i, "B").Value & "  à déja expirée depuis le : " & Cells(i, "D").Value & "  /  " & Cells(i, "E").Value & "  /  " & Cells(i, "F").Value)
If p > -7 And p < 0 Then MsgBox ("Date CDC pour " & Cells(i, "A").Value & "   " & Cells(i, "B").Value & "  Prévue le :  " & Cells(i, "D").Value & "  /  " & Cells(i, "E").Value & "  /  " & Cells(i, "F").Value)
Next i
End Sub

vers feuil2 :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub AlerteNVfeuille()
Dim w1 As Worksheet
Dim w2 As Worksheet
Set w1 = Sheets("feuil1")
Set w2 = Sheets("feuil2")
Dim i As Long
Dim D As Date
Dim j As Integer
 
Application.ScreenUpdating = False
'nettoyer feuille 2 qui recevera les taches à échéance proche
Sheets("feuil2").Range("A:F").Clear
Sheets("feuil2").Cells(2, 1).Resize(1, 6) = Array("Code", "Fournisseur", "Date CDC", "DATE FT", "Date REV", "Remarque")
j = 3
Set w1 = Worksheets("feuil1") 'Feuille qui contient les alertes
D = Date
' ********************************* Période d'éssai
For i = 2 To w1.Range("D" & Rows.Count).End(xlUp).Row
p = D - w1.Range("D" & i)
If p >= 0 Then
w2.Cells(j, 1) = w1.Cells(i, "A").Value
w2.Cells(j, 2) = w1.Cells(i, "B").Value
w2.Cells(j, 3) = w1.Cells(i, "D").Value
w2.Cells(j, 4) = w1.Cells(i, "E").Value
w2.Cells(j, 5) = w1.Cells(i, "F").Value
w2.Cells(j, 6) = "Date CDC expirée !!!"
j = j + 1
End If
If p > -7 And p < 0 Then
w2.Cells(j, 1) = w1.Cells(i, "A").Value
w2.Cells(j, 2) = w1.Cells(i, "B").Value
w2.Cells(j, 3) = w1.Cells(i, "D").Value
w2.Cells(j, 4) = w1.Cells(i, "E").Value
w2.Cells(j, 5) = w1.Cells(i, "F").Value
w2.Cells(j, 6) = "Date CDC arrive à échéance dans moins de 7 jours"
j = j + 1
End If
Next i
 
 
 w2.Activate
 w2.Cells(1, 1) = "Journée du : " & Date & "  SITUATION DANS 7 JOURS"
 'Call Mise_en_forme
 w2.Select
 Application.ScreenUpdating = True
End Sub

08/01/2019, 15h38
WalTT

Merci pour le travail réalisé.

Dans un premier temps je cherche à faire un Msgbox mais l'objectif final sera d'envoyer directement un e-mail au fournisseur.

Sachant qu'il y a plusieurs réf par fournisseur et qu'il y a plusieurs dates à contrôler, le message que je cherche a faire serait:

Fournisseur X
MP32 la date du CDC arrive à échéance

ou

Fournisseur Y
MP36 la date du CDC arrive à échéance et la date de la FT arrive à échéance

ou

Fournisseur Y
MP39 la date de la FT arrive à échéance
MP46 la date du CDC arrive à échéance
08/01/2019, 15h49
BENNASR

la différence par rapport à la proposition fournie svp (bouton1) ??

En faisant un essai j'ai mis sur la MP028 le fournisseur SARKOUZI.

Quant on appui sur bouton 1 il y apparait 2 message pour SARKOUZI alors j'aimerai groupé en un message.

Voir mon code, j'avance mais n'y suis pas encore

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub ComptIdentique()
 
 
Dim Email As String
Dim DernLigne As Long
Dim T_date
Dim Message As String
Dim MessageCDC As String
Dim MessageFT As String
Dim MessageREF As String
Dim DateCDC As String
Dim DateFT As String
Dim DateREV As String
Dim Ref As String
 
Dim i As Integer
Dim j As Integer
Dim PlageEmail As Range
Dim prec As String
Dim Delai As Integer
Dim Année As Integer
 
 
 
Set PlageEmail = Worksheets("feuil1").Range("C1: C65000 ")
 
T_date = Date
Année = 3 'ans
Delai = Année * 365
 
DernLigne = Range("C1048576").End(xlUp).Row
 
 
 
 
    For i = 1 To DernLigne
 
          Email = Range("C1").Offset(i).Value
 
          For j = 1 To DernLigne
             Ref = Range("A1").Offset(j).Value
             DateCDC = Range("F1").Offset(j).Value
             DateFT = Range("H1").Offset(j).Value
             DateREV = Range("J1").Offset(j).Value
 
 
            If Range("C1").Offset(j).Value = Email Then
 
            If T_date - Delai > DateCDC Then
            MessageCDC = " délai CDC " & DateCDC & " arrive à échéance"
            End If
            If T_date - Delai > DateFT Then
            MessageFT = " délai FT " & DateFT & " arrive à échéance"
            End If
            If T_date - Delai > DateREV Then
            MessageREV = " délai REV " & DateREV & " arrive à échéance"
            End If
 
            If T_date - Delai > DateCDC Or T_date - Delai > DateFT Or T_date - Delai > DateREV Then
 
            Message = Message & Ref & vbCrLf & MessageCDC & vbCrLf & MessageFT & vbCrLf & MessageREV & vbCrLf
 
                If Message <> "" Then
                     MsgBox "Fournisseur " & Email & vbCrLf & vbCrLf & Message
 
 
 
        End If
        End If
        End If
 
 
 
         Next j
 
        Message = ""
        Ref = ""
        DateCDC = ""
        DateFT = ""
        DateREV = ""
        MessageCDC = ""
        MessageFT = ""
        MessageREV = ""
 
    Next i
 
 
 
    Email = ""
 
End Sub