Microsoft 365 Problème dans formule VBA

BOILEAU

XLDnaute Junior
Bonjour,

J’ai besoin d’aide sur ma formule VBA.

Je vous joins mon calendrier Excel vide d'infos persos dans lequel existe ma formule VBA

Le principe de cette formule est de renseigner automatiquement les cellules des lignes LA DISCRETE, L’INTIME, LA GENEREUSE, LA SPACIEUSE dans les colonnes CE à CP.

Chaque cellule du mois (exemple : CN 20) doit s’incrémenter (addition du nombre de date correspondant au même mois) en fonction de la date qui s’affiche dans, exemples : les cellules BA 22 et BE 22. Les dates dans ces cellules, s’affichent automatiquement lorsque l’on remplit les cellules, exemples : BA 20, BE 21, BI 20.

La formule VBA fonctionne parfaitement jusque-là.

Mon problème est que lorsque j’efface uniquement la date, exemple : BI 22, ma cellule CN 20 reste incrémenté sur le chiffre 3 (dans cet exemple), alors qu’elle devrait être à 2. Il n’y a que deux dates de renseignées dans le calendrier.

J’espère que vous pourrez m’aider à résoudre de problème.

Un grand merci d’avance.

Bonne journée,

Frédéric
 

Pièces jointes

  • PLANNING EXEMPLE.xlsm
    191.1 KB · Affichages: 2

vgendron

XLDnaute Barbatruc
Hello

je ne vois pas ou est ta formule VBA..??
du moins;. je ne vois pas de quoi tu parles

tes formules dans ta feuille sont compliquées et longues...
regarde celles que j'ai mises en jaune en BU18:BX18 pour remplacer celles de BU21:BX21
 

Pièces jointes

  • PLANNING EXEMPLE.xlsm
    190.3 KB · Affichages: 1

BOILEAU

XLDnaute Junior
Hello

je ne vois pas ou est ta formule VBA..??
du moins;. je ne vois pas de quoi tu parles

tes formules dans ta feuille sont compliquées et longues...
regarde celles que j'ai mises en jaune en BU18:BX18 pour remplacer celles de BU21:BX21
Bonjour vgendron
Merci pour ta formule simplifiée. Ma formule VBA se trouve bien dans mon fichier Excel. je te joins une capture d'écran.
Sinon, la voici :
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 DE RESA" Then Exit Sub

If Not IsEmpty(Target(1, 1).Value) Then DtMod = Date

Set Target = Target(2, 1)
If Cells(Target.Row, "C") <> "DATE DE RESA" 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 DE RESA" 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

Mon problème se situe dans le tableau colonne CC a CP.

Merci de ton aide.
Frédéric
 

Pièces jointes

  • Capture d’écran 2024-10-30 à 13.54.32.png
    Capture d’écran 2024-10-30 à 13.54.32.png
    447.4 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
il n'y a pas de formule la dedans..
une formule, c'est une expression mathématique qui commence par = et qui calcule un résultat

toi.. tu as "juste" du code qui fait.. bah.. je sais pas trop justement...

déjà.. faire un target(2,1) sur une target qui ne contient qu'une ligne.. c'est étrange.... la je dirais que ca tombe en marche...
si tu souhaites la ligne en dessous, il faut faire un offset
et comme toi, tu cherches la ligne de date qui se trouve 1 ou 2 lignes en dessous de ta target il faudrait simplement faire

VB:
if range("C" &target.row+1)="DATE DE RESA" then
   lig=target.row+1
else
   lig=target.row+2
end if
 

vgendron

XLDnaute Barbatruc
voir ce code. avec commentaires

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 Or Range("C" & Target.Row) = "DATE DE RESA" Then Exit Sub
    
    If Not IsEmpty(Target(1, 1).Value) Then DtMod = Date
    
    'recherche de la ligne de date==> ici, on présume qu'il n'y a QUE 2 lignes (+1 pour la date) par établissement
    If Range("C" & Target.Row + 1) = "DATE DE RESA" Then
       lig = Target.Row + 1
       off = 1
    Else
       lig = Target.Row + 2
       off = 2
    End If

    DtMod = Date 'je ne vois pas l'intérêt de passer par une variable...
    
    If Range("C" & lig) <> "DATE DE RESA" Then Exit Sub 'cas ou on a inscrit du texte entre les etablissements

    Application.EnableEvents = False
    
    Target.Offset(off, 0) = IIf(Target(1, 1).Value = "", "", DtMod) 'permet d'effacer la date si on efface l'intitulé ==> Quid du cas où il y a deux réservations la meme nuit?
    
    TDatM = Intersect([D:BM], Target.Offset(off).EntireRow).Value
    For C = 1 To UBound(TDatM, 2) 'compte le nombre de date par mois
        If IsDate(TDatM(1, C)) Then
            M = Month(TDatM(1, C))
            TMois(1, M) = TMois(1, M) + 1
        End If
    Next C
        
    [CE:CP].Rows(Target.Row - (2 - off)).Value = TMois 'on colle le tableau à la bonne ligne
    Application.EnableEvents = True
End Sub
 

Discussions similaires

Réponses
2
Affichages
988

Statistiques des forums

Discussions
314 499
Messages
2 110 249
Membres
110 711
dernier inscrit
chmessi