Encore une petite modif

taz067 · Mars 19, 2024, 6:54

Hello
alors ma petite modif consiste dans le code ci-dessous, à ignorer purement et simplement les jours de week-end que sont les samedis et dimanche
le code actuel m’inscrits la date en colonne A comment le configurer, que le code prenne en compte tous les jours de semaine sauf le WE
Actuellement même si je renseigne mes données le lundi, le code affiche dans ma cellule en colonne A le samedi, même si le vendredi n’est pas affiché, dans l’idéal, il faudrait que le code vérifie si la dernière cellule de la colonne A est un jour de semaine, du lundi au vendredi, et que soit s’il voit un jeudi, et ce même si je le remplis le lundi, il me met le vendredi qui est 3 jours avant le lundi, et quand, je renseigne le mardi, il recommence au lundi.
Pour le moment, je reprends les jours manuellement les lundi et mardi

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D2:D4:H22")) Is Nothing Then
Dim i%, Dl%, DIPlueValue, Ws As Worksheet, Wd As Worksheet

Set Ws = Sheets("Valeur")
Set Wd = Sheets("Montant")
Dl = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1


  If Wd.Cells(Dl - 1, 1).Value = Date - 1 Then
'Wd.Cells(D1 - 1, 1).Value = Date Then
    Wd.Cells(Dl - 1, 1).Value = Date - 1
    Wd.Cells(Dl - 1, 2).Value = Ws.Range("D5")
    Wd.Cells(Dl - 1, 4).Value = Ws.Range("D3")
    Wd.Cells(Dl - 1, 6).Value = Ws.Range("J2")
    Wd.Cells(Dl - 1, 7).Value = Ws.Range("F5")
    Wd.Cells(Dl - 1, 8).Value = Ws.Range("F3")
    Wd.Cells(Dl - 1, 9).Value = Ws.Range("J4")
    Wd.Cells(Dl - 1, 11).Value = Ws.Range("H4")
    
  Else
    Wd.Cells(Dl, 1).Value = Date - 1
'Wd.Cells(Dl, 1).Value = Date
    Wd.Cells(Dl, 2).Value = Ws.Range("D5")
    Wd.Cells(Dl, 4).Value = Ws.Range("D3")
    Wd.Cells(Dl, 6).Value = Ws.Range("J2")
    Wd.Cells(Dl, 7).Value = Ws.Range("F5")
    Wd.Cells(Dl, 8).Value = Ws.Range("F3")
    Wd.Cells(Dl, 9).Value = Ws.Range("J4")
    Wd.Cells(Dl, 11).Value = Ws.Range("H4")
    
  If Wd.Cells(Dl - 1, 1).Value = Date -1 Then
    Wd.Cells(Dl - 1, 13).Value = Ws.Range("H22")
    Wd.Cells(Dl - 1, 14).Value = Ws.Range("F14")
    Wd.Cells(Dl - 1, 15).Value = Ws.Range("H14")
    Wd.Cells(Dl - 1, 16).Value = Ws.Range("F16")
    
    
  Else
    Wd.Cells(Dl, 1).Value = Date - 1
    Wd.Cells(Dl, 13).Value = Ws.Range("H22")
    Wd.Cells(Dl, 14).Value = Ws.Range("F14")
    Wd.Cells(Dl, 15).Value = Ws.Range("H14")
    Wd.Cells(Dl, 16).Value = Ws.Range("F16")
    
    
    End If
  End If
End If

Johnny · Mars 20, 2024, 5:23

Bonjour Taz

Peux etre en rajoutent une condition de vérification si c’est un week end ou pas :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range(« D2:D4:H22 »)) Is Nothing Then
Dim i As Integer, Dl As Long
Dim Ws As Worksheet, Wd As Worksheet
Dim currentDay As Integer

    Set Ws = Sheets("Valeur")
    Set Wd = Sheets("Montant")
    Dl = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    **' Vérifier si le jour actuel est un jour de semaine**
    currentDay = Weekday(Date)
    If currentDay >= 2 And currentDay <= 6 Then ' Du lundi au vendredi
        If Wd.Cells(Dl - 1, 1).Value = Date - 1 Then
            Wd.Cells(Dl - 1, 1).Value = Date - 1
            Wd.Cells(Dl - 1, 2).Value = Ws.Range("D5")
            Wd.Cells(Dl - 1, 4).Value = Ws.Range("D3")
            Wd.Cells(Dl - 1, 6).Value = Ws.Range("J2")
            Wd.Cells(Dl - 1, 7).Value = Ws.Range("F5")
            Wd.Cells(Dl - 1, 8).Value = Ws.Range("F3")
            Wd.Cells(Dl - 1, 9).Value = Ws.Range("J4")
            Wd.Cells(Dl - 1, 11).Value = Ws.Range("H4")
        Else
            Wd.Cells(Dl, 1).Value = Date - 1
            Wd.Cells(Dl, 2).Value = Ws.Range("D5")
            Wd.Cells(Dl, 4).Value = Ws.Range("D3")
            Wd.Cells(Dl, 6).Value = Ws.Range("J2")
            Wd.Cells(Dl, 7).Value = Ws.Range("F5")
            Wd.Cells(Dl, 8).Value = Ws.Range("F3")
            Wd.Cells(Dl, 9).Value = Ws.Range("J4")
            Wd.Cells(Dl, 11).Value = Ws.Range("H4")
        End If
    End If
End If

End Sub

Salutations

taz067 · Mars 20, 2024, 8:23

hello
voila un fichier avec juste les deux onglets nécessaires, si je rajoute tes lignes de code dans le fichier original, j’ai une erreur sur cette ligne qui me dit machin non defini ou un truc dans ce style

Capture d'écran 2024-03-20 092236

test.xlsm (225,8 Ko)

Johnny · Mars 20, 2024, 9:00

Re Taz

A teste j’espere avoir bien compris

test.xlsm (226,2 Ko)

Cow18 · Mars 20, 2024, 10:41

re,
on peut utiliser la fonction VBA WorkDay_Intl pour cela et comme ça on peut choisir les jours ouvrables et eventuellement exclure les jour fériés

Sub test()
     Dim MaDate, i
     MaDate = DateSerial(2024, 3, 20)        'quelque part un jour aléatoire
     For i = 1 To 7                          'les 7 jours suivants
          b = (WorksheetFunction.WorkDay_Intl(MaDate + i - 1, 1) = MaDate + i)     'd'un jour, on prend le prochain jour ouvrable du jour précédent. Si c'est le jour même, c'est un jour ouvrable
          MsgBox "la date " & IIf(b, " est", " n'est pas ") & " un jour ouvrable", , Format(MaDate + i, "ddd dd-mm-yy")
     Next
End Sub

taz067 · Avril 5, 2024, 4:59

Bon, j’ai testé vos deux solutions, mais elle ne fonctionne pas comme je le souhaiterai
j’ai donc posé la question à ChatGPT
et voilà ce qu’il m’a pondu, en debut du code je l’ai donc « adapté » a ma sauce sans savoir si ça va fonctionner, sauriez vous me dire si comme je l’ai « inseré » ça pourrais fonctionner

Option Explicit

'***MACRO CRÉE PAR CHATGPT3***
'Sub InsérerVendrediPrécédent()
 '   Dim currentDate As Date, previousFriday As Date
      ' Obtenez la date actuelle
   ' currentDate = Date
       ' Vérifiez si aujourd'hui est lundi (valeur 2 pour lundi)
    'If Weekday(currentDate) = 2 Then
        ' Calculez la date du vendredi précédent
     '   previousFriday = DateAdd("d", -((Weekday(currentDate) + 1) Mod 7), currentDate)
            ' Insérez la date du vendredi précédent dans la colonne A
      '  Range("A1").Value = previousFriday
 '   End If
'End Sub
'***FIN DE LA MACRO DE CHATGPT***


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D2:D4:H22")) Is Nothing Then
Dim i%, Dl%, DIPlueValue, Ws As Worksheet, Wd As Worksheet
                                                                                '***ajout de deux lignes***
 '***variable date***
        Dim currentDate As Date, previousFriday As Date
 '*** 3 prochaine lignes sont le code original***
Set Ws = Sheets("Valeur")
Set Wd = Sheets("Montant")
Dl = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1
  '***nouvel ajout jusqu au end if***Obtenez la date actuelle***
    currentDate = Date
   '***Vérifiez si aujourd'hui est lundi (valeur 2 pour lundi)***
    If Weekday(currentDate) = 2 Then
    '***Calculez la date du vendredi précédent***
        previousFriday = DateAdd("d", -((Weekday(currentDate) + 1) Mod 7), currentDate)
   '***Insérez la date du vendredi précédent dans la colonne A***
        Range("A1").Value = previousFriday
    End If
     '***fin du code pour le vendredi***

  If Wd.Cells(Dl - 1, 1).Value = Date - 1 Then
'Wd.Cells(D1 - 1, 1).Value = Date Then
    Wd.Cells(Dl - 1, 1).Value = Date - 1
    Wd.Cells(Dl - 1, 2).Value = Ws.Range("D5")
    Wd.Cells(Dl - 1, 4).Value = Ws.Range("D3")
    Wd.Cells(Dl - 1, 6).Value = Ws.Range("J2")
    Wd.Cells(Dl - 1, 7).Value = Ws.Range("F5")
    Wd.Cells(Dl - 1, 8).Value = Ws.Range("F3")
    Wd.Cells(Dl - 1, 9).Value = Ws.Range("J4")
    Wd.Cells(Dl - 1, 11).Value = Ws.Range("H4")
    
  Else
    Wd.Cells(Dl, 1).Value = Date - 1
'Wd.Cells(Dl, 1).Value = Date
    Wd.Cells(Dl, 2).Value = Ws.Range("D5")
    Wd.Cells(Dl, 4).Value = Ws.Range("D3")
    Wd.Cells(Dl, 6).Value = Ws.Range("J2")
    Wd.Cells(Dl, 7).Value = Ws.Range("F5")
    Wd.Cells(Dl, 8).Value = Ws.Range("F3")
    Wd.Cells(Dl, 9).Value = Ws.Range("J4")
    Wd.Cells(Dl, 11).Value = Ws.Range("H4")
    
  If Wd.Cells(Dl - 1, 1).Value = Date - 2 Then
'Wd.Cells(Dl - 1, 1).Value = Date - 1 Then
    Wd.Cells(Dl - 1, 13).Value = Ws.Range("H22")
    Wd.Cells(Dl - 1, 14).Value = Ws.Range("F14")
    Wd.Cells(Dl - 1, 15).Value = Ws.Range("H14")
    Wd.Cells(Dl - 1, 16).Value = Ws.Range("F16")
    
    
  Else
    Wd.Cells(Dl, 1).Value = Date - 2
'Wd.Cells(Dl, 1).Value = Date - 1
    Wd.Cells(Dl, 13).Value = Ws.Range("H22")
    Wd.Cells(Dl, 14).Value = Ws.Range("F14")
    Wd.Cells(Dl, 15).Value = Ws.Range("H14")
    Wd.Cells(Dl, 16).Value = Ws.Range("F16")
    
    
    End If
  End If
End If
End Sub

Cow18 · Avril 6, 2024, 12:35

votre question est quoi ? Vous avez un jour et vous voulez le jour ouvrable précédent ?
2 exemples

Sub Jour_Ouvrable_Precedent()
     Dim JOP, Mardi_Precedent
     
     JOP = WorksheetFunction.WorkDay_Intl(Date, -1)
     MsgBox "on est le " & Format(Date, "ddd dd-mm-yy") & vbLf & "le jour ouvrable précédent est le " & Format(JOP, "ddd dd-mm-yy")
     
     Mardi_Precedent = WorksheetFunction.WorkDay_Intl(Date, -1, "1011111") 'tous des 1, sauf le 2eme = le mardi est le seul jour ouvrable de la semaine
     MsgBox "on est le " & Format(Date, "ddd dd-mm-yy") & vbLf & "le mardi précédent est le " & Format(Mardi_Precedent, "ddd dd-mm-yy")
     
End Sub

taz067 · Avril 6, 2024, 6:23

Hello,
Mon problème est que dans mon fichier, j’ai dans un onglet, trois cellules que je modifie tous les jours, la macro actuel copie les résultats de ces modifications dans un tableau sur un autre onglet, mais que les modifs, je ne les fais que du lundi au vendredi, pour des résultats qui se décalent.
Le lundi, j’ai les résultats du vendredi,
le mardi, résultat du lundi,
mercredi résultat du mardi etc.
Actuellement quand je mets à jour le lundi, dans l’onglet résultat s’affiche le samedi, donc je modifie à la main pour y mettre la date du vendredi, et le mardi, quand je refais la mise à jour, je me retrouve à nouveau avec le dimanche, donc je suis, là aussi, obligé de refaire la modif de date au lundi cette fois, à partir des modifs du mercredi tout est normal puisque ça me remet le mardi à la suite dans mon tableau…

Cow18 · Avril 6, 2024, 1:58

bon, si je comprends bien, le lundi, on doit inscrire les données du vendredi dans le tableau du vendredi. Voir macro « TAZ067 » en prenant compte des jours fériés + jours weekend, on écrit dans le tableau correspondant.
Feuille « Fériés » sont tous les jours fériés de 2023 à 2030.
Feuille « BDD » sont les jours ouvrables à partir du 2/1/2024, donc les jours où vous devez inscrire des données du jour ouvrable précédent. La macro assigne les 5 tableaux structurés (TBL_Lundi, TBL_Mardi, …, TBL_Vendredi) et n première colonne, j’écris ce jour d’inscrire. La 2ième colonne est le jour ouvrable sans tenir compte avec les jour fériés et la 3eme colonne c’est la même chose mais on tient compte avec les jour fériés.
Donc, par exemple dans le tableau « TBL_Lundi » tous les jours de la 3eme colonne (colonne F) sont des « lundis » mais les jours dans la première colonne (D) en face ne sont pas tous des « mardis »
J’ai ajouté une MFC pour le tableau du lundi et une formule + filtrer en colonne G pour le tableau du mardi

J’éspère que cela vous donne un idée pour résoudre votre problème.
J’utilise une macro dans un module normal, parce que les tableaux structurés ne s’assignent pas aussi facilement dans un module d’une feuille.
TAZ067.xlsm (68,7 Ko)

taz067 · Avril 7, 2024, 8:59

Bon, je n’ai pas tout compris !
le plus simple est que je te mets mon fichier, tu verras sur l’onglet montant que je n’ai pas encore de « vendredi » puisque sur le site, il n’y a pas encore les valeurs que je renseigne dans l’onglet valeur, .

Si hypothétiquement, aujourd’hui dimanche, je modifie la valeur ça me mettra bien le vendredi, mais et si je continue, demain ça me mettra samedi, or lundi ça devrait me mettre vendredi et je suis obligé de modifier le samedi en vendredi, sachant que la dernière fois de la semaine, je puisse récupérer la valeur seras le vendredi pour le jeudi.

Mardi, on devrait revenir à lundi, mais si je renseigne mardi la valeur, le tableau me renverra de nouveau samedi, et je devrais à nouveau faire la modification manuelle de la date.

ps, les cellules que je modifie sont les cellules D2, D4 et D14, et a la première modification le tableau des montants se met à jour, petit détail aussi, si le même jour je modifie les cellules D2 et D4 celles-ci se mettent à jour sur la bonne ligne, mai spas la D14 qui me rajoute systématiquement une ligne

suivi.xlsm (526,5 Ko)

FFO · Avril 7, 2024, 2:59

Bonjour taz
Je m’aventure à te proposer ce fichier adapté à ma sauce
peut-être te conviendra t’il
Testes et dis moi

suivi.xlsm (525,5 Ko)

taz067 · Avril 7, 2024, 3:20

Hello FFO
je te dirai demain ce qu’il en est, mais déjà pour aujourd’hui ça a l’air bon !

FFO · Avril 7, 2024, 3:35

Merci pour ce retour rapide
Déjà une très bonne nouvelle
Croisons les doigts pour demain
Il me tarde !!!

Cow18 · Avril 7, 2024, 8:35

Range(« D2:D4:H22 ») est une construction bizarre, c’est quoi que vous voulez ?

Sub test()
     MsgBox "1 " & Range("D2:D4:H22").Address
     MsgBox "2 " & Range("D2,D4,H22").Address
     MsgBox "3 " & Range("D2,D4:H22").Address
End Sub

quand je lis votre explication c’est uniquement range(« D2,D4,D14 »), non ?
le fichier avec ma proposition
suivi (1).xlsm (532,9 Ko)

taz067 · Avril 7, 2024, 9:57

Les cellules que je modifie manuellement sont bien D2, D4 et D14,
Mais en fait H22 fait l’arrondi de F14 -H16, F14 étant lui-même une valeur copiée d’un autre onglet et c’est cette arrondie que j’affiche en B22, sur B22, j’ai fait une mise en forme par formule, qui selon que la somme soit positive ou négative m’affiche « plus-value » ou « moins-value » avec l’arrondi de H22,

=SI(H14<0;"Moins-value "&H22&" €";SI(H14>0;"Plus-value "&H22&" €";""))

mais c’est l’arrondi H22 qui est copié dans le tableau montant, je sais, c’est capillotracté, mais j’ai fait ce fichier quand je débutai avec Excel est les formules, et je n’ai pas envie de me retaper tout le fichier pour faire d’autre formule.

J’aime bien le message box !

  'à partir d'ici, je ne le comprends plus concernant ces dates....
               If Wd.Cells(Dl - 1, 1).Value = WorksheetFunction.WorkDay_Intl(Date, -2) Then     'ligne précédent = 2 jours ouvrables précédent
                    'Wd.Cells(Dl - 1, 1).Value = Date - 1 Then
                    Wd.Cells(Dl - 1, 13).Value = Ws.Range("H22")
                    Wd.Cells(Dl - 1, 14).Value = Ws.Range("F14")
                    Wd.Cells(Dl - 1, 15).Value = Ws.Range("H14")
                    Wd.Cells(Dl - 1, 16).Value = Ws.Range("F16")


               Else
                    Wd.Cells(Dl, 1).Value = Date - 2
                    'Wd.Cells(Dl, 1).Value = Date - 1
                    Wd.Cells(Dl, 13).Value = Ws.Range("H22")
                    Wd.Cells(Dl, 14).Value = Ws.Range("F14")
                    Wd.Cells(Dl, 15).Value = Ws.Range("H14")
                    Wd.Cells(Dl, 16).Value = Ws.Range("F16")

En fait cette partie concerne un autre site ou les jours sont décalés d’un jour de plus encore, donc )il faut que cette entrée se fasse sur la ligne de la date avant le jour,
en gros si je renseigne le vendredi les cellules D2,D4 et D14 le tableau pour les cellules D2 et D4 sera mis à jour avec le jeudi, mais la cellule D14, elle concerne une mise à jour de mercredi…

Et je sais là aussi, c’est pénible à gérer, mais malheureusement, je ne gère pas les sites suivit…je ne peut que « subir » leurs gestions

Cow18 · Avril 8, 2024, 1:03

re,
c’est peut-être difficile d’écrire comme ceci, mais cela simplifie la code, car en utilisant une valeur boolean (avec VRAI = -1), on peut supprimer la moitié.

Private Sub Worksheet_Change(ByVal Target As Range)

     Dim i%, Dl%, DIPlueValue, Ws As Worksheet, Wd As Worksheet, Jour_Précédent As Long, bDrapeau As Boolean, bDrapeau2 As Boolean

     If Not Application.Intersect(Target, Range("D2,D4,D14,D16")) Is Nothing Then     '<<<<<<<<<<<<<<<< CES CELLULES ?????

          Set Ws = Sheets("Valeur")          'on peut aussi utiliser "Me" parce que vous êtes ici dans le module de la feuille "Valeur"
          Set Wd = Sheets("Montant")
          Dl = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1

          Jour_Précédent = WorksheetFunction.WorkDay_Intl(Date, -1)
          MsgBox "on est le " & Format(Date, "ddd dd-mm") & vbLf & "Le changement est pour le " & Format(Jour_Précédent, "ddd dd-mm")

          bDrapeau = (Wd.Cells(Dl - 1, 1).Value = Jour_Précédent)     'jour ouvrable précédent est la même date que la dernière ligne de Montant = juste changer ligne existante, autrement nouvelle ligne
          Wd.Cells(Dl + bDrapeau, 1).Value = Jour_Précédent
          Wd.Cells(Dl + bDrapeau, 2).Value = Ws.Range("D5")
          Wd.Cells(Dl + bDrapeau, 4).Value = Ws.Range("D3")
          Wd.Cells(Dl + bDrapeau, 6).Value = Ws.Range("J2")
          Wd.Cells(Dl + bDrapeau, 7).Value = Ws.Range("F5")
          Wd.Cells(Dl + bDrapeau, 8).Value = Ws.Range("F3")
          Wd.Cells(Dl + bDrapeau, 9).Value = Ws.Range("J4")
          Wd.Cells(Dl + bDrapeau, 11).Value = Ws.Range("H4")

          If Not bDrapeau Then               'seulement au moment où c'est une nouvelle date
               'à partir d'ici, je ne le comprends plus concernant ces dates....
               bDrapeau2 = (Wd.Cells(Dl - 1, 1).Value = WorksheetFunction.WorkDay_Intl(Date, -2))     'ligne précédent = 2 jours ouvrables précédent
               'Wd.Cells(Dl + bDrapeau2, 1).Value = Date -2
               Wd.Cells(Dl + bDrapeau2, 13).Value = Ws.Range("H22")
               Wd.Cells(Dl + bDrapeau2, 14).Value = Ws.Range("F14")
               Wd.Cells(Dl + bDrapeau2, 15).Value = Ws.Range("H14")
               Wd.Cells(Dl + bDrapeau2, 16).Value = Ws.Range("F16")
          End If
     End If
End Sub

Cow18 · Avril 8, 2024, 1:07

ceci est peut-être trop …

If Not bDrapeau Then               'seulement au moment où c'est une nouvelle date
               'à partir d'ici, je ne le comprends plus concernant ces dates....
               bDrapeau2 = (Wd.Cells(Dl - 1, 1).Value = WorksheetFunction.WorkDay_Intl(Date, -2))     'ligne précédent = 2 jours ouvrables précédent
               'Wd.Cells(Dl + bDrapeau2, 1).Value = Date -2
               Arr = Array(Ws.Range("H22"), Ws.Range("F14"), Ws.Range("H14"), Ws.Range("F16")) 'une matrice avec ces 4 éléments
               Wd.Cells(Dl + bDrapeau2, 13).Resize(, 4).Value = Arr
          End If

suivi (1).xlsm (532,1 Ko)

Pour ces données d’un autre site, ne pouvez-vous pas sauvegarder dans une cellule la date qui correspond à ces 4 valeurs.

taz067 · Avril 8, 2024, 11:09

Je regarde ce soir et demain si ça fonctionne comme prevue, et vous dirais mon ressenti

taz067 · Avril 8, 2024, 5:15

@FFO @Cow18
Bon, je suis embêté, du coup, j’ai trois fichiers qui fonctionnent bien pour les changements du lundi et je ne sais pas lequel garder…

FFO · Avril 8, 2024, 5:39

Bonsoir taz

Est ce à dire que pour ceci c’est du positif :

« Hello FFO
je te dirai demain ce qu’il en est, mais déjà pour aujourd’hui ça a l’air bon ! »

Pour ton choix cornélien seule solution tu jettes les 3 fichiers en l’aire et le premier qui touche le sol est l’heureux élu !!!

Une idée comme une autre pour sortir de cette impasse

Hélas je n’ai pas mieux !!!