Microsoft 365 générer automatiquement une date selon la condition d'une cellule

BOILEAU

XLDnaute Junior
Bonsoir,
Je n'arrive pas à écrire ma formule VBA. Et pourtant cela me semble simple et j'ai un peu honte de vous demander de l'aide. je suis sur Mac.

J'ai une plage de cellules (E20:BM21) mes cellules sont fusionnées deux par deux (E20etF20 _ G20etH20_.....) pour chacune des lignes 35 et 36. Je souhaiterais inscrire automatiquement la date de modification si une cellule fusionnée par exemple E20etF20 est vide.
En clair :
Si (E20/F20) ou (E21etF21) n'est pas vide, la date du jour de la modification de cette cellule fusionnée doit s'inscrire dans la cellule du dessous E22/F22.. La date de modification ne doit pas se mettre à jours à chaque ouverture du fichier.

Cette procédure ce reproduit sur plusieurs ligne dans ma feuille. Document joint.

Un grand merci d'avance à ceux qui pourront m'aider.

Bonne soirée

Frédéric
 

Pièces jointes

  • PLANNING HDG MODELE VIERGE.xlsm
    152.9 KB · Affichages: 30
Solution
Modifiée comme suit, la procédure semble faire ce que vous souhaitez en plus :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim DtMod, TDatM(), C&, M&, TMois(1 To 1, 1 To 12)
   If Intersect([D:BM], Target) Is Nothing Then Exit Sub
   If Cells(Target.Row, "C") = "DATE MODIF" Then Exit Sub
   If Not IsEmpty(Target(1, 1).Value) Then DtMod = Date
   Set Target = Target(2, 1)
   If Cells(Target.Row, "C") <> "DATE MODIF" Then
      If Not IsEmpty(Target.Value) Then DtMod = Date
      Set Target = Target(2, 1)
   ElseIf Not IsEmpty(Target(-1, 1).Value) Then
      DtMod = Date
      End If
   If Cells(Target.Row, "C") <> "DATE MODIF" Then Exit Sub
   Target.Value = DtMod
   TDatM = Intersect([D:BM], Target.EntireRow).Value
   For...

BOILEAU

XLDnaute Junior
Bonjour.

Je ne comprends pas vos explications: la date ne peut être changée qu'aux lignes portant "DATE MODIF" en colonne C. Par contre ça s'applique à l'ensemble des colonnes à partir de la D. Vous n'aviez pas dit qu'il y avait d'autre choses au delà de la BM. Peut être vaudrait il mieux remplacer

par
VB:
   If Intersect([D:BM], Target) Is Nothing Then Exit Sub
Merci pour votre retour.
Désolé de na pas avoir signalé que des informations existaient après la colonne BM. Mais dans mon premier fichier joint, il existait bien des informations après la colonne BM.
Ce qui est nouveau dans mon fichier c'est les colonnes CC:CP. Je pensais avoir la capacité de trouver moi même la solution à la création de ce tableau. Mais presque une nuit blanche n'aura pas suffit ! je m'incline !
Merci pour votre aide.
Frédéric
 

Dranreb

XLDnaute Barbatruc
Modifiée comme suit, la procédure semble faire ce que vous souhaitez en plus :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim DtMod, TDatM(), C&, M&, TMois(1 To 1, 1 To 12)
   If Intersect([D:BM], Target) Is Nothing Then Exit Sub
   If Cells(Target.Row, "C") = "DATE MODIF" Then Exit Sub
   If Not IsEmpty(Target(1, 1).Value) Then DtMod = Date
   Set Target = Target(2, 1)
   If Cells(Target.Row, "C") <> "DATE MODIF" Then
      If Not IsEmpty(Target.Value) Then DtMod = Date
      Set Target = Target(2, 1)
   ElseIf Not IsEmpty(Target(-1, 1).Value) Then
      DtMod = Date
      End If
   If Cells(Target.Row, "C") <> "DATE MODIF" Then Exit Sub
   Target.Value = DtMod
   TDatM = Intersect([D:BM], Target.EntireRow).Value
   For C = 1 To UBound(TDatM, 2)
      If IsDate(TDatM(1, C)) Then M = Month(TDatM(1, C)): TMois(1, M) = TMois(1, M) + 1
      Next C
   Application.EnableEvents = False
   [CE:CP].Rows(Target.Row - 2).Value = TMois
   Application.EnableEvents = True
   End Sub
Enfin, elle laisse des vides au lieu de 0. Ça pourrait s'arranger si vous tenez aux 0 …
Il suffirait en fait d'ajouter As Double derrière la déclaration de TMois(1 To 1, 1 To 12)
 
Dernière édition:

BOILEAU

XLDnaute Junior
Modifiée comme suit, la procédure semble faire ce que vous souhaitez en plus :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim DtMod, TDatM(), C&, M&, TMois(1 To 1, 1 To 12)
   If Intersect([D:BM], Target) Is Nothing Then Exit Sub
   If Cells(Target.Row, "C") = "DATE MODIF" Then Exit Sub
   If Not IsEmpty(Target(1, 1).Value) Then DtMod = Date
   Set Target = Target(2, 1)
   If Cells(Target.Row, "C") <> "DATE MODIF" Then
      If Not IsEmpty(Target.Value) Then DtMod = Date
      Set Target = Target(2, 1)
   ElseIf Not IsEmpty(Target(-1, 1).Value) Then
      DtMod = Date
      End If
   If Cells(Target.Row, "C") <> "DATE MODIF" Then Exit Sub
   Target.Value = DtMod
   TDatM = Intersect([D:BM], Target.EntireRow).Value
   For C = 1 To UBound(TDatM, 2)
      If IsDate(TDatM(1, C)) Then M = Month(TDatM(1, C)): TMois(1, M) = TMois(1, M) + 1
      Next C
   Application.EnableEvents = False
   [CE:CP].Rows(Target.Row - 2).Value = TMois
   Application.EnableEvents = True
   End Sub
Enfin, elle laisse des vides au lieu de 0. Ça pourrait s'arranger si vous tenez aux 0 …
Il suffirait en fait d'ajouter As Double derrière la déclaration de TMois(1 To 1, 1 To 12)
Bonjour Dranreb,

C'est top de chez top !!! Un très grand merci.
Les cellules vides au lieu des 0 c'est très très bien,
Je vais enfin pouvoir mettre en place mes statistiques.
Encore merci et Bravo !
Frédéric
 

BOILEAU

XLDnaute Junior
Bonjour Dranreb,

désolé de t'embêter encore.
J'ai un petit soucis !
Tout marche très bien en automatique. Lorsque je modifie une cellule, la date du jour s'inscrit et le nombre de cellule contenant le même mois (de la ligne "date modif") est bien calculé et inscrit dans la bonne case.
Mon problème est que je dois reprendre mes archives passées. Je dois donc rentrer manuellement les dates dans les cellules des lignes ("date modifs") - (exemple : 2/02/19 - 13/6/18 - 14/05/20 ........). Je peux les inscrire manuellement dans la cellule, mais le calcul du nombre de cellule ayant le même mois ne se fait pas dans le tableau prévu à cet effet (CC:CP) !
As-tu une idée ?
Merci d'avance.
Frédéric
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je n'avais pas pensé à ça.
C'est à cause du If Cells(Target.Row, "C") = "DATE MODIF" Then Exit Sub
Ne pourrait-on faire If Cells(Target.Row, "C") <> "DATE MODIF" Then,
Indenter vers la droite en dessous jusqu'au End If à ajouter derrière Target.Value = DtMod ?
Comme ça la mise à jour en CE:CP serait faite après quand même
 

BOILEAU

XLDnaute Junior
Pas de souci, on ne peu pas penser à tout !!
Tu veux dire :
remplacer If Cells(Target.Row, "C") = "DATE MODIF" Then Exit Sub par If Cells(Target.Row, "C") <> "DATE MODIF" Then
et
déplacer la ligne End if pour la rajouter comme cela : Target.Value = DtMod ? End If
 

Dranreb

XLDnaute Barbatruc
C'est un End If à ajouter après l'affection. S'il est mis sur la même ligne qu'elle il faut séparer par deux points les deux instructions. Conseil: décaler vers la droite toutes les instruction après le Then jusqu'au End If
 

Dranreb

XLDnaute Barbatruc
Apparamment un End If correspondant à un autre If à Then non directement suivi d'une instruction, qui existait déjà, a été déplacé, au lieu d'en ajouter un pour ce nouveau If de ce type.
Oui c'est le End If derrière DtMod = Date qui a été supprimé au lieu d'être simplement décalé vers la droite comme le reste des instructions
 
Dernière édition:

BOILEAU

XLDnaute Junior
Bonjour Dranreb,
J'espère que vous allez bien.
La formule VBA (fichier joint) que vous m'avez donnée l'année dernière fonctionne parfaitement. Re-Merci !

Aujourd'hui, je suis devant un nouveau problème. Je commence à avoir des réservations pour 2023. Lors que j'enregistre dans mon nouveau tableau excel 2023 cette réservation, c'est la date du jour en 2022 qui s'inscrit. Ce qui est normal par rapport à la formule existante.
Est-il possible de modifier la formule afin de faire en sorte que si une réservation pour 2023 est faite en 2022, la date qui doit s'inscrire est le 1/01/2023.
La fonctionnalité première ne doit pas disparaître, à savoir que si une réservation est faite en 2023 pour 2023, c'est bien la date du jour de la réservation qui doit s'inscrire.

Vous remerciant encore de votre aide.

Cordialement,

Frédéric
 

Pièces jointes

  • FORMULE VBA.docx
    12.3 KB · Affichages: 2

BOILEAU

XLDnaute Junior
Bonjour.
Peut être en mettant :
VB:
If CInt(Me.Name) > Year(Date) Then DtMod = DateSerial(CInt(Me.Name), 1, 1) Else DtMod = Date
Bonjour,
Merci pour ce retour et ton aide.
J'ai essayer, pour ne pas t'embêter pour rien, de l'insérer à plusieurs endroits du code VB actuel.
Pas de résultat probant !!! parfois la date du 1/01/2023 s'inscrit, parfois non c'est celle du jours. Quand la date en 2023 s'inscrit et que je supprime la résa, la date reste affichée.
Comme je suis nul en VBA, je me dis qu'il faut peut-être remplacer une ligne de code existante par cette nouvelle. Mais laquelle ?
Où placer cette ligne dans la formule VBA existante ?
Merci d'avance
Frédéric
 

Discussions similaires

Statistiques des forums

Discussions
315 095
Messages
2 116 166
Membres
112 675
dernier inscrit
Tazra_IMOU