Référence circulaire
Bonjour le forum,
je suis confronté à une formule, dont je n'ai pas trouvée mieux, qui me renvoie une référence circulaire et vous allez vite comprendre pourquoi : =SI(A2="";"";SI(F2<>"";F2;MAINTENANT()))
En fait, ce que je cherche à faire, c'est d'inscrire la date du jour en colonne F quand il y a une saisie dans la colonne A, et faire en sorte que la date dans F reste figée.
Autre demande : je voudrais que quand la colonne K est renseignée, figer le ''X'' dans les colonnes H ou I ou J :
Par avance, merci de vous être penché sur ma requête
Bonjour,
Il faut procéder avec une macro événementielle (VBA) pour le résultat.
Merci de joindre un fichier.
Cdlt.
Fichier en PJ.
Pour la macro, possibilité de la dissocier en la mettant dans la réponse du forum ?
La mettre dans un fichier xlsm ne m'arrange pas car mon entreprise bloque toutes les macros de fichiers téléchargés depuis le web.
Merci
Bonjour,
une proposition,
mettre le code dans le module de la feuille RDP TL1
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:K")) Is Nothing Then
If Target.Row > 1 And Target.Column <> 6 And Cells(Target.Row, "F") = "" Then
Application.EnableEvents = False
Cells(Target.Row, "F") = Now()
Application.EnableEvents = True
End If
End If
End Sub
Merci pour le code mais je n'arrive pas à le faire fonctionner, il me demande un nom de macro !
Bonjour !
La macro s'exécute automatiquement à chaque changement de sélection dans la feuille (voir cours : https://www.excel-pratique.com/fr/vba/evenements_classeur.php), si ce changement à lieu dans les colonnes A à K. Donc pas de bouton, pas d’exécution manuelle...
Re,
Bonjour h2so4
Je te fais la totale.
Ces procédures sont à copier dans ThisWorkbook de ton classeur.
Les données sont sous forme de tableaux. J'ai supprimé la colonne Date (aujourdhui()).
Pour finaliser la chose, on peut protéger les feuilles pour empêcher toute modification incongrue !...
Les procédures sont à copier dans le module ThisWorkbook du classeur.
A tester dans son ensemble.
A te relire.
Cdlt.
Option Explicit
Dim lo As ListObject, lr As ListRow
Dim lCol As Long, lRow As Long
Dim dt As Date
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2":
On Error GoTo err_Handler
Application.EnableEvents = False
Set lo = Sh.ListObjects(1)
With lo
For Each lr In .ListRows
If Not IsEmpty(lr.Range.Cells(1, 1)) And IsEmpty(lr.Range.Cells(1, 10)) Then
lr.Range.Cells(1, 7).Resize(, 3).ClearContents
dt = Date
Select Case dt - lr.Range.Cells(1, 6)
Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
Case Else: lr.Range.Cells(1, 9).Value = "X"
End Select
End If
Next lr
End With
Case Else:
End Select
exit_Handler:
Application.EnableEvents = True
Set lo = Nothing
Exit Sub
err_Handler:
MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
Resume exit_Handler
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2"
On Error GoTo err_Handler
Application.EnableEvents = False
If Target.ListObject Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Set lo = Sh.ListObjects(1)
lCol = Target.Column - lo.HeaderRowRange.Column + 1
lRow = Target.Row - lo.HeaderRowRange.Row
Set lr = lo.ListRows(lRow)
Select Case lCol
Case 1: If Not IsEmpty(Target) Then Target.Offset(, 5).Value = Date
End Select
dt = Date
Select Case dt - lr.Range.Cells(1, 6)
Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
Case Else: lr.Range.Cells(1, 9).Value = "X"
End Select
Case Else:
End Select
exit_Handler:
Application.EnableEvents = True
Set lr = Nothing
Set lo = Nothing
Exit Sub
err_Handler:
MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
Resume exit_Handler
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2"
On Error GoTo err_Handler
Application.EnableEvents = False
If Target.ListObject Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Set lo = Sh.ListObjects(1)
lCol = Target.Column - lo.HeaderRowRange.Column + 1
Select Case lCol
Case 10: If Not IsEmpty(Target) Then lo.HeaderRowRange.Cells(1).Select
End Select
Case Else:
End Select
exit_Handler:
Application.EnableEvents = True
Set lo = Nothing
Exit Sub
err_Handler:
MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
Resume exit_Handler
End Sub
bonjour
Merci pour le code mais je n'arrive pas à le faire fonctionner, il me demande un nom de macro !
le nom de la macro est
Private Sub Worksheet_Change(ByVal Target As Range)
et non
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
il s'agit d'une macro qui s'exécute lorsqu'un changement est détecté sur la feuille en question.
Merci Jean-Eric, c'est très complet et ce qu'il me faut
Cependant, mon tableau va comporter plusieurs lignes que j'ai créé mais avec lesquelles ton code ne fonctionne plus
Il y a peut-être une modification de code à faire mais vu mon niveau, impossible de la faire moi-même
Re,
Merci de ce retour.
J'ai mis les données sous forme de tableaux (structurés). Ils sont dynamiques.
Lors du redimensionnement, les formules, les mises en formes et les validations sont reproduits à l'insertion de nouvelles lignes.
Précise ta question.
Cdlt;
Re,
Je regarde la chose !...
Cdlt.
Re,
A tester !...
Option Explicit
Dim lo As ListObject, lr As ListRow
Dim lCol As Long, lRow As Long
Dim dt As Date
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2":
Set lo = Sh.ListObjects(1)
With lo
If .ListRows.Count = 0 Then Exit Sub
For Each lr In .ListRows
If Not IsEmpty(lr.Range.Cells(1, 1)) And IsEmpty(lr.Range.Cells(1, 10)) Then
lr.Range.Cells(1, 7).Resize(, 3).ClearContents
dt = Date
Select Case dt - lr.Range.Cells(1, 6)
Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
Case Else: lr.Range.Cells(1, 9).Value = "X"
End Select
End If
Next lr
End With
Case Else:
End Select
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2"
If Target.ListObject Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Set lo = Sh.ListObjects(1)
lCol = Target.Column - lo.HeaderRowRange.Column + 1
lRow = Target.Row - lo.HeaderRowRange.Row
Set lr = lo.ListRows(lRow)
Application.EnableEvents = False
Select Case lCol
Case 1: If Not IsEmpty(Target) Then Target.Offset(, 5).Value = Date
End Select
dt = Date
lr.Range.Cells(1, 7).Resize(, 3).ClearContents
Select Case dt - lr.Range.Cells(1, 6)
Case Is <= 7: lr.Range.Cells(1, 7).Value = "X"
Case Is < 31: lr.Range.Cells(1, 8).Value = "X"
Case Else: lr.Range.Cells(1, 9).Value = "X"
End Select
Application.EnableEvents = True
Case Else:
End Select
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "RdP TL1", "RdP TL2"
If Target.ListObject Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Set lo = Sh.ListObjects(1)
lCol = Target.Column - lo.HeaderRowRange.Column + 1
Select Case lCol
Case 10: If Not IsEmpty(Target) Then lo.HeaderRowRange.Cells(1).Select
End Select
Case Else:
End Select
End Sub