Tableau test date avec message groupé

**WalTT** · 08/01/2019, 12h15

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**BENNASR** · 08/01/2019, 14h52

Bonsoir
deux propositions pour le prix d'une seule !!! les soldes de fin d'année encore la

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**WalTT** · 08/01/2019, 15h38

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

**BENNASR** · 08/01/2019, 15h49

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

**WalTT** · 08/01/2019, 16h02

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Tableau test date avec message groupé

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager