Microsoft 365 Formule spéciale en vba

[Amymone]

Bonjour le forum

Mes meilleurs vœux pour cette année 2023.
Serait -il possible si la commande est livré en G mettre alors "ok" en H et si possible en vba, je vous remercie

 

[sylvanu]

Bonjour Amymone,
Un essai en PJ avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [G4:G1000]) Is Nothing Then
         Ligne = Target.Row
         If Cells(Ligne, "F") <> "" And Target <> "" Then Cells(Ligne, "H") = "Ok"
    End If
Fin:
End Sub

Dans l'état on regarde juste si F et G est non vide, sans se préoccuper si ce sont des dates ou non.
Donc on peut l'affiner et l'améliorer au besoin.

 

[Amymone]

Bonjour sylvanu
la formule est parfaite, en revanche il faut garder aussi l'autre formule "=SI(ET(F4<>"";F4+2<AUJOURDHUI());"Relance";"")" je te remercie

 

[sylvanu]

Re,

Serait -il possible si la commande est livré en G mettre alors "ok" en H et si possible en vba, je vous remercie

C'est ce que fait ma PJ. Si il n'y a pas de date en G, je ne touche rien, votre formule en H reste intacte.
Ou set ce que vous voulez que la Relance soit effectuée par VBA ? Dans ce cas votre demande est incomplète.

 

[Amymone]

Re,

Tout à fait ça ma demande était incomplète et je m'en excuse, si la date en G disparait alors la formule relance doit apparaître

 

[sylvanu]

Re,
En PJ une approche que par VBA sans formule :
1- A l'ouverture du fichier, analyse de toutes les lignes et ré actualisation des Relance, avec :

Private Sub Workbook_Open()
With Feuil1
    Application.ScreenUpdating = False
    .[H4:H1000].Clear
    For L = 4 To .[F65500].End(xlUp).Row
        If .Cells(L, "F") <> "" And .Cells(L, "G") <> "" Then
            .Cells(L, "H") = "Ok"
        ElseIf .Cells(L, "F") < Date And .Cells(L, "G") = "" Then
                .Cells(L, "H") = "Relance"
                .Cells(L, "H").Font.Color = vbRed
                .Cells(L, "H").Font.Bold = True
        ElseIf .Cells(L, "F") > Date And .Cells(L, "G") = "" Then
                ' Calcul du temps avant relance, à supprimer si non necessaire.
                .Cells(L, "H") = "Relance dans " & .Cells(L, "F") - Date & " jours."
                .Cells(L, "H").Font.Italic = True
        End If
    Next L
End With
End Sub

2- Par modif de la colonne G, réactualisation des données.

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [G4:G1000]) Is Nothing Then
         Ligne = Target.Row
         If Cells(Ligne, "F") <> "" And Target <> "" Then
            Cells(Ligne, "H") = "Ok"
            Cells(Ligne, "H").Font.Color = vbBlack
            Cells(Ligne, "H").Font.Bold = False
         ElseIf Cells(Ligne, "F") <> "" And Target = "" Then
            Cells(Ligne, "H") = "Relance"
            Cells(Ligne, "H").Font.Color = vbRed
            Cells(Ligne, "H").Font.Bold = True
        End If
    End If
Fin:
End Sub

La méthode que par VBA évite d'avoir des formules en H à propager.
L'analyse à l'ouverture du fichier réactualise les données en fonction de la date d'aujourd'hui, ce qui change les résultats si le fichier n'a pas été ouvert depuis plusieurs jours.
A noter que la Relance dans xx jours peut être supprimée dans le code, c'est indiqué.

 

[Amymone]

Re,

Il y a un petit souci car "relance" doit apparaitre seulement 3 jours après la date limite de livraison et non à toutes les dates. Si nous somme le 12 janvier 2023 et que la date limite de livraison est le 10 janvier 2023 rien ne doit apparaître, ainsi de suite, j'espère que j'ai été claire
Merci

 

[sylvanu]

Re,
Vous auriez pu rectifier de vous même, c'était un simple bug, il y avait .Cells(L, "F") < Date au lieu de .Cells(L, "F") < Date - 2.
J'ai simplifié la macro avec la date de relance, ce sera plus simple à maintenir si vous vouliez faire des modifs.

 

[Amymone]

Re, c'est super je te remercie encore, bonne soirée et à bientôt

 

[patricktoulon]

bonsoir à tout les deux
moi je me pose la question
que va t il se passer si je tape autre chose qu'une date dans les cellule en "F"

Private Sub Workbook_Open()
With Feuil1
Application.ScreenUpdating = False
.[H4:H1000].Clear
For L = 4 To .[F65500].End(xlUp).Row

If .Cells(L, "F") <> "" And .Cells(L, "G") <> "" Then
.Cells(L, "H") = "Ok"


ElseIf .Cells(L, "F") < Date And .Cells(L, "G") = "" Then
.Cells(L, "H") = "Relance"
.Cells(L, "H").Font.Color = vbRed
.Cells(L, "H").Font.Bold = True


ElseIf .Cells(L, "F") > Date And .Cells(L, "G") = "" Then
' Calcul du temps avant relance, à supprimer si non necessaire.
.Cells(L, "H") = "Relance dans " & .Cells(L, "F") - Date & " jours."
.Cells(L, "H").Font.Italic = True
End If
Next L
End With
End Sub

 

[sylvanu]

Bonsoir Patrick,
C'est ce que j'ai dit au post #2 :

Dans l'état on regarde juste si F et G est non vide, sans se préoccuper si ce sont des dates ou non.
Donc on peut l'affiner et l'améliorer au besoin.

Mais n'ai eu aucune réponse de la part de Amymone. Donc c'est resté dans l'état.

 

[Amymone]

Bonjour Sylvanu et PatrickToulon
J'ai répondu à ton message en précisant que c'était ok

 

[sylvanu]

Oups! Sorry.

la formule est parfaite

Je n'avais pas fait le rapport avec l'aspect sécurité sur les dates.

 

[Amymone]

Salut Sylvanu
C'est pas grave et encore mille merci pour tes compétences

 

[patricktoulon]

Bonsoir tout les deux
je crois qu'une démo vaut mieux que des mots
essayer de taper
n'importe quoi
une date
ou tout ce que vous voudrez
et lancez la sub

Sub test()
    L = 1
    With Feuil1

        If .Cells(L, "F") <> "" And .Cells(L, "G") <> "" Then
            texte = "ok" & vbCrLf


        ElseIf .Cells(L, "F") < Date And .Cells(L, "G") = "" Then
            texte = texte & "Relance" & vbCrLf
            texte = texte & "couleur=" & vbRed & vbCrLf
            texte = texte & "Bold =" & True


        ElseIf .Cells(L, "F") > Date And .Cells(L, "G") = "" Then
            ' Calcul du temps avant relance, à supprimer si non necessaire.
            texte = texte & "Relance dans " & .Cells(L, "F") - Date & " jours."
            texte = texte & "Italic =" & True
        End If
    End With
    MsgBox texte
End Sub