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.

af

Autre demande : je voudrais que quand la colonne K est renseignée, figer le ''X'' dans les colonnes H ou I ou J :

hijk

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 !

macro

Et si j'en rentre un et le crée, bien évidemment il se crée dans "Modules" avec

Sub macro()

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,

quand je tape du texte en A2, ton code fonctionne

quand je tape du texte en A3, les bordures s'ajoutent automatiquement par contre ton code n'ajoute rien en F :

capture

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
Rechercher des sujets similaires à "reference circulaire"