XL 2010 Ecrire automatiquement des données dans des cellules

jeje77

XLDnaute Junior
Bonjour à tous,

J’ai deux tableaux liés entre eux pour les MFC, Lors des changements d'année mes tableaux changent et le surlignage change dans le tableau 2 avec les dates correspondant au tableau 1.

J'aurais voulus savoir si il était possible d'écrire automatiquement les lettres" XP " dans les cases surlignées dès lors que c'est un week-end ou un jour fériés.

Je ne sais pas si il faut passer par une MFC ou si il faut que ce soit fait par le biais d'un module VBA

Ci-joint un exemple de mon fichier.

Par avance je vous remercie pour votre aide

Cordialement
 

Pièces jointes

  • Test XP.xlsx
    26 KB · Affichages: 16

sousou

XLDnaute Barbatruc
Bonjour.
Un peu tiré par les cheveux;)
Quelqu'un a Surement mieux?
Sub deb()
Set zone = Sheets(1).Range("f8:k42")
Application.ScreenUpdating = False

'zone.Select
For Each i In zone
'i.Select
ad = i.Address
For Each f In i.FormatConditions
x = f.Formula1

If Cells(i.Row - 1, 1).FormulaLocal = "" Then
Cells(i.Row, 1).FormulaLocal = x
Else
Cells(i.Row - 1, 1).Copy Cells(i.Row, 1)
End If
If Cells(i.Row, 1) = True Then i.Value = "XP"

Next
Next
c = zone.Column
zone.Columns(1).Offset(0, -c + 1).ClearContents
Application.ScreenUpdating = True
End Sub
 

jeje77

XLDnaute Junior
Bonjour,
Merci pour votre réponse

Quand j’exécute cette macro, le message erreur de compilation "Variable non définie" apparait
et sur la ligne : Set zone = Sheets(1).Range("f8:k42"), "zone =" est surligné et la macro s’arrête sur : Sub deb()

Quelle variable dois-je définir ?

cordialement
 

Pièces jointes

  • Test XP.xlsm
    31.1 KB · Affichages: 7

jeje77

XLDnaute Junior
Bonjour
supprime option explicit.
Cette option t'obliges à définir toutes les variables qui seront utilisées avant.
C'est plus pro, mais tu pourras toujours le faire après si nécéssaire
Merci pour cette info.
Après avoir supprimé "option explicit", je lance la macro qui fonctionne mais ça copie "XP" sur toute les lignes correspondantes au dates du TAB.1 alors que je n'est besoin que des samedis et les dimanches surlignés dans le TAB.2.
Peut être n,est-ce pas possible :(
Merci quand même
 

job75

XLDnaute Barbatruc
Bonjour jeje77, sousou,

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, ncol%, j%
'---liste des jours de garde---
tablo = [B7].CurrentRegion.Resize(, 2).Value2 'matrice des valeurs, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If tablo(i, 2) <> "" Then d(CStr(tablo(i, 2))) = ""
Next i
'---traitement du 2ème tablo---
With [E7].CurrentRegion
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'au moins 2 cellules
    tablo = .Resize(, ncol).Formula 'matrice des formules, plus rapide
    For i = 2 To UBound(tablo)
        If d.exists(tablo(i, 1)) Then
            For j = 2 To ncol
                tablo(i, j) = "XP"
            Next j
        End If
    Next i
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    .Replace "XP", "", xlWhole 'RAZ
    .Formula = tablo 'restitution
    Application.EnableEvents = True
End With
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

Les XP s'inscrivent et ne peuvent plus être effacés.

A+
 

Pièces jointes

  • Test XP(1).xlsm
    27.2 KB · Affichages: 12

sousou

XLDnaute Barbatruc
RE
J'avais pas compris!
Sur le même principe


Sub deb()

Set zone = Sheets(1).Range("c8:c15")
Application.ScreenUpdating = False

zone.Select
For Each i In zone
flag = 0
i.Select
ad = i.Address
For Each f In i.FormatConditions
x = f.Formula1

If Cells(i.Row - 1, 1).FormulaLocal = "" Then
Cells(i.Row, 1).FormulaLocal = x
Else
Cells(i.Row - 1, 1).Copy Cells(i.Row, 1)
End If
On Error Resume Next
If Cells(i.Row, 1) = True Then
flag = 1
Call ecritxp(i)
End If
Next
On Error GoTo 0
Next
c = zone.Column
zone.Columns(1).Offset(0, -c + 1).ClearContents
Application.ScreenUpdating = True

End Sub

Sub ecritxp(i)
Set zone = Sheets(1).Range("e8:k42")
For Each c In zone.Columns(1).Rows
If c = i Then

For n = 1 To zone.Columns.Count - 1
c.Offset(0, n) = "XP"
Next
Exit Sub
End If
Next
 

jeje77

XLDnaute Junior
RE
J'avais pas compris!
Sur le même principe


Sub deb()

Set zone = Sheets(1).Range("c8:c15")
Application.ScreenUpdating = False

zone.Select
For Each i In zone
flag = 0
i.Select
ad = i.Address
For Each f In i.FormatConditions
x = f.Formula1

If Cells(i.Row - 1, 1).FormulaLocal = "" Then
Cells(i.Row, 1).FormulaLocal = x
Else
Cells(i.Row - 1, 1).Copy Cells(i.Row, 1)
End If
On Error Resume Next
If Cells(i.Row, 1) = True Then
flag = 1
Call ecritxp(i)
End If
Next
On Error GoTo 0
Next
c = zone.Column
zone.Columns(1).Offset(0, -c + 1).ClearContents
Application.ScreenUpdating = True

End Sub

Sub ecritxp(i)
Set zone = Sheets(1).Range("e8:k42")
For Each c In zone.Columns(1).Rows
If c = i Then

For n = 1 To zone.Columns.Count - 1
c.Offset(0, n) = "XP"
Next
Exit Sub
End If
Next

Merci, c'est presque ce que je recherche mais ça ne prend pas en compte les dimanches et la dernière ligne est copiée après la dernière date du mois ???
Quand on lance la macro pas à pas, on voit bien la recherche les jours fériés et les week-ends en colonne A mais pour le dimanche il affiche un résultat faux en cellule A10.

1572457131720.png
 

job75

XLDnaute Barbatruc
]e n'ai pas zapper le post #6 et je m'excuse si cela vous à contrarié, mais je ne cherche pas à ce que les jours ne puissent pas êtres modifiés.
Vous n'avez pas compris ni testé, bien sûr qu'on peut modifier les jours, ce sont les XP qui ne peuvent être effacés une fois que les jours sont fixés.

Ce phénomène se produit parce qu'on utilise une macro Worksheet_Change.
 

jeje77

XLDnaute Junior
:rolleyes:
J'avais oublié de te dire que j'avais modifier le mfc du tab1 en une seule formule, ce qui ne devrait pas te gêner.
Donc je te joint le fichier
Job: Pas grave ;)

Merci pour ce code je viens de le testé ça va très bien, mais je n'ai pas réussi à intégrer la prise en compte des jours fériés à la MFC que tu as modifié j'ai un refus si je rajoute la condition "=OU(E8=Feries)" à la suite apparemment on ne peut pas mettre plus de 2 conditions
Bon ! Je vais le testé sur mon véritable classeur voir si ça va.
Ça risque d’être un peu long il y a une cinquantaine de feuilles 4 équipes (4 x 12 mois)
Je vous remercie et je reviens vers vous.

Bien cordialement
jeje77
 

jeje77

XLDnaute Junior
Vous n'avez pas compris ni testé, bien sûr qu'on peut modifier les jours, ce sont les XP qui ne peuvent être effacés une fois que les jours sont fixés.

Ce phénomène se produit parce qu'on utilise une macro Worksheet_Change.

j'avais testé votre fichier mais cela ne correspondait pas à mon attente, il ne faut pas se moquer c'est pas bien.
Je ne suis pas un pro du VBA et je ne voulais pas que l'on ne puisse plus modifier les "XP" par un autre code.
Il peut y avoir une absence au dernier moment et de plus les "XP" servent à comptabilisé les jours de week-ends et fériés pour les indemnités repas.
 

jeje77

XLDnaute Junior
Ma solution fait exactement ce que vous demandez au post #1, qu'est ce que c'est que cette histoire des absences ?

Je n'ai fait aucun commentaires qui auraient pu déplaire.
Au post #1 ma demande était : ... écrire automatiquement les lettres" XP " dans les cases surlignées dès lors que c'est un week-end ou un jour fériés. Pas les autres jours.
il peut y avoir des absences non prévues et il faut pouvoir changer le "XP" par un repos un congés maladie ou autre.
 

Discussions similaires

Réponses
12
Affichages
542

Statistiques des forums

Discussions
311 709
Messages
2 081 768
Membres
101 816
dernier inscrit
Jfrcs