[VBA] Test entre deux dates + affichages

Version imprimable

15/05/2008, 11h18
titocv723

[VBA] Test entre deux dates + affichages

Bonjour,

Je cherche à créer une macro pour mon fichier excel sur une comparaison entre 2 dates.
En gros, j'ai une colonne de date (colonne Q de ma sheet "Liste") qui contienne des dates à ne pas dépasser. J'aimerais créer une macro qui à l'ouverture du fichier excel, teste si les dates contenues dans cette colonnes sont dépassées et si Oui m'affiche un pop up avec la valeur de la cellule E correspondante dans la sheet "Liste (si la date G5 est dépassée pop up avec le texte contenu dans la cellule E5). J'aimerais que s'il y a plusieurs dates dépassées il affiche dans le même pop up toutes les cellules E correspondantes.
Est ce faisable ? Et si oui pouvez vous m'aider?

Merci de votre aide.

Bonjour,

Cela devrait ressembler à :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TEST()
Dim x As String, i As Integer
 
With Sheets("liste")
    '7 = colonne G, remplacer 7 par 17 si colonne Q
    For i = 2 To .Cells(Rows.Count, 7).End(xlUp).Row
        If .Cells(i, 7) < Date Then x = x & Chr(10) & .Cells(i, 5).Value
    Next
End With
 
MsgBox "Dates dépassées :" & Chr(10) & x
 
End Sub

Code:

1
2
3
Private Sub Workbook_Open()
TEST
End Sub

Dans ton message tu dis que les dates sont situées en colonne Q et ensuite tu dis qu'elles sont en colonne G...donc à vérifier et adapter si nécessaire

Bonjour

Je ne comprends pas bien tes références colonnes alors pour l'exemple ci dessous, j'ai placé à partir de A2 les dates à tester et à partir de B2 les dates limites. Je considère qu'il n'y a pas de cellules vides dans ta liste de dates de la colonne A.
Place ce code dans "ThisWorkbook" de ton classeur.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub Workbook_Open() Lig = 2 Col = 1 Msg = "" Do DateTest = Cells(Lig, Col).Value If DateTest = "" Then Exit Do DateRef = Cells(Lig, Col + 1).Value If DateTest > DateRef Then Msg = Msg & DateTest & " ligne= " & Lig & Chr(10) End If Lig = Lig + 1 Loop If Msg <> "" Then Beep MsgBox (Msg) Else MsgBox ("R.A.S !") End If End Sub
à plus

15/05/2008, 14h26
titocv723

Merci Fring, c'était exactement ce que je voulais.