XL 2019 Problème boucle ?

[crackerwood]

Bonjour tous le monde.
Je viens vers vous pour un petit souci d'optimisation de code VBA.
En effet je fais un tableau budget et j'ai un onglet calendrier + un par mois (et d'autre mais on s'en moque pour ici).
Je voudrais quand je rentre un achat du jour (ex : course) que ce mot s'affiche dans mon calendrier au bon jour en checkant les catégories du mois. J'ai trouvé un moyen mais (et vous pourrais le voir) le code est nul et trop long donc je dépasse la longueur du code VBA autorisé. Je pense qu'une boucle réglera le souci mais je laisse les pros faire car pour le moment je maîtrise pas. Je demande juste le code pour un seul mois et j'adapterais pour les suivant moi-même et ça me fera apprendre en même temps.
Je sais que cela est un peu vague mais je vous joint mon fichier avec des ajout d'explication.
Je vous remercie par avance.
fichier ex : https://www.cjoint.com/c/LACqi6oLlZF

 

[JBARBE]

Bonjour crackerwood, Bonjour à tous,
Il existe beaucoup de programmes pour les comptes bancaires et plus simple que le tient !
Alors pourquoi se casser la tête !
Bonne journée !

 

[crackerwood]

Salut. Merci de ta réponse mais c'est aussi comme un défi perso de faire quelque chose que j'ai fais seul. Enfin sans compter l'aide demandé. Sinon je n'aurais rien écris et pris mais je trouve que c'est pas pareil

 

[JBARBE]

Salut. Merci de ta réponse mais c'est aussi comme un défi perso de faire quelque chose que j'ai fais seul. Enfin sans compter l'aide demandé. Sinon je n'aurais rien écris et pris mais je trouve que c'est pas pareil

C'est très bien mais le fait de surfer sur le forum ma permis de mieux comprendre les formules et macros VBA dont je n'avais que de petites notions procurées dans des vieux bouquins !
Cela dit, le VBA complexe et certaines formules sont hors de ma portée !
C'est pourquoi, je n'interviens que modérément sur le forum, mais reste curieux de toutes demandes d'intervention !
Bon courage et bonne soirée !

 

[AtTheOne]

Bonsoir les noctambules ! Bonsoir @crackerwood
J'ai écrit une procédure qui effectue les 2 tâches : Date de l'opération dans la feuille du mois et Type de dépenses dans la feuille calendrier :

'Dans le module "M01_Remplir_Date_Type"

Option Base 1

Sub Remplir_Date_Type_Dépense(Source As Range)

Dim PlagesMois, Sh_Calendrier As Worksheet, Rg_Mois As Range, Jour As Date
Dim Valeurs, Valeur, Tb(1 To 2) As Byte, i As Integer, j As Integer
    
     Col = Source.Column: Lgn = Source.Row
    
     'Conditions à réunir
     If Source.Count > 1 Then Exit Sub
     If Col > 26 Or Not (Col Mod 4 = 2) Then Exit Sub  'Colonne entre 2 et 26 et  =2 modulo 4
     If Lgn < 33 Or Lgn > 65 Then Exit Sub             'Ligne entre 33 et 65
     'Conditions réunies
    
     'Date du jour dans la colonne à droite de la source
     Jour = Date
     Source.Offset(0, 1).Value = Jour
    
     Set Sh_Calendrier = Feuil1
    
     'Plage occupée par les mois dans la feuille Calendrier
     PlagesMois = Array("B6:H17", "J6:P17", "R6:R17", _
                        "B22:H33", "J22:P33", "R22:R33", _
                        "B38:H49", "J38:P49", "R38:R49", _
                        "B54:H65", "J54:P65", "R54:R65")
    
     'Plage occupée par le mois en cours
     Set Rg_Mois = Sh_Calendrier.Range(PlagesMois(Month(Date)))
     'Valeurs contenue dans Rg_Mois
     Valeurs = Rg_Mois.Value
    
     'Trouver le jour courant
     For i = 1 To UBound(Valeurs, 2)
          For j = 1 To UBound(Valeurs, 1)
               If Valeurs(j, i) = Jour Then
                    'mémoriser les index et sortir de la boucle
                    Tb(1) = j: Tb(2) = i
                    Exit For
               End If
               'Si les index sont mémorisés sortir de la boucle
               If Tb(1) > 0 Then Exit For
          Next j
     Next i
     'Si aucun index Erreur on sort sans rien faire
     If Tb(1) < 1 Or Tb(2) < 1 Then Exit Sub
    
     'Ajout éventuel d'un retour chariot si la valeur de la cellule n'est pas vide
     If Not IsEmpty(Valeurs(Tb(1) + 1, Tb(2))) Then Valeurs(Tb(1) + 1, Tb(2)) = Valeurs(Tb(1) + 1, Tb(2)) & vbCrLf
    
     'Compléter la valeur de la cellule du jour
     Rg_Mois.Cells(Tb(1) + 1, Tb(2)).Value = Valeurs(Tb(1) + 1, Tb(2)) & Source.Value

End Sub

Le code de chaque feuille Mois devient :

Private Sub worksheet_activate()
    Range("A1").Select
    ScrollArea = "A1:AD65" 'pour bloquer la feuille
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

     Application.EnableEvents = False
     Remplir_Date_Type_Dépense Target
     Application.EnableEvents = True

End Sub

j'ai épuré l’événement Activate de la feuille Calendrier (sans toucher aux lignes suivantes):

Private Sub worksheet_activate()
    'Range("A1").Select
    Feuil1.ScrollArea = "A1:X65" 'affichage max
'Selection du curseur sur la date du jour
    Dim d As Date, cal As Range, cel As Range
    d = Int(Now())
    Set cal = Range("B5:X65")
For Each cel In cal.Cells
    If cel.Value = d Then cel.Offset(1, 0).Resize(1, 1).Select: Exit For
Next cel
End Sub

Voilà
Bon courage pour la suite
Alain

 

[crackerwood]

Bonjour @AtTheOne ou plutôt Alain. Alors la merci pour avoir fais ça aussi tard. J'ai regardé un peu et je vous remercie pour le code.
Un grand merci.