Autres [RÉSOLU] Compléter la macro mais comment et où?

un internaute · 15 Août 2025

Bonjour le forum
Dans un fichier lorsque je tape par exemple 10 cellule B11 ça affiche la date cellule A11 ensuite je tape 10 par exemple cellule C11 puis double clique cellule E11 et F11 ça affiche les noms du médecin et laboratoire

Je voudrais lorsque je fais Supr sur n'importe quelle cellule colonne B ça efface la date (colonne A) ça efface aussi n'importe quelle cellule colonne C mais surtout que ça efface n'importe quelle cellule colonne E et F mais surtout garde la formule colonne D
J'ai essayé de "bricoler" quelque chose mais n'y arrive pas alors... le forum
Je pense que l'explication n'est pas au top ... mais je ne peux pas fournir de fichier
Merci d'avance à vous

VB:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim DerLig As Long
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
   
    If Not Intersect(Range("B3:B" & Target.Row), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target <> "" Then
            If Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then              'Interdire séance le même jour
                MsgBox "Un Résultat existe à cette date"                                       'Interdire séance le même jour
                Target = ""
            End If
        End If
        Range("G" & Target.Row) = IIf(Target = "", "", Date)
        Range("A" & Target.Row) = IIf(Target = "", "", Application.Proper(Format(Date, "dddd dd mmmm yyyy")))
        If Range("C" & Target.Row) <> "" Then Range("C" & Target.Row) = ""
    ElseIf Not Intersect(Target, Range("A3:A" & DerLig)) Is Nothing Then
        If Not IsDate(Target) Then
            Target = ""
            Range("B" & Target.Row).ClearContents
        End If
        Range("G" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))
        Range("A" & Target.Row) = IIf(Target = "", "", Application.Proper(Format(Target, "dddd dd mmmm yyyy")))
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub

gbinforme · 15 Août 2025

Bonjour,

avec ce que j'ai compris je te suggère ceci :

VB:

...
If Not Intersect(Range("B3:B" & Target.Row), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target <> "" Then
            If Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then              'Interdire séance le même jour
                MsgBox "Un Résultat existe à cette date"                                       'Interdire séance le même jour
                Target = ""
            End If
        Else
            Range("A" & Target.Row).ClearContents
            Range("C" & Target.Row).ClearContents
            Range("E" & Target.Row & ":E" & Target.Row).ClearContents
        End If
...

un internaute · 16 Août 2025

Bonsoir le forum
Excusez mon retard à répondre
Voici et ça fonctionne
Sans fichier pas facile pour vous je le reconnais d'autant plus que j'explique assez mal
Merci à vous
Bonne fin de soirée

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim DerLig As Long
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    
    If Not Intersect(Range("B3:B" & Target.Row), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target <> "" Then
            If Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then               'Interdire séance le même jour
                MsgBox "Un Résultat existe à cette date"                                       'Interdire séance le même jour
                Target = ""
            End If
        End If
        If Target <> "" Then
          Range("G" & Target.Row) = Date
          Range("A" & Target.Row) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
        Else
          On Error Resume Next
          Range("A" & Target.Row).Resize(, 7).SpecialCells(xlCellTypeConstants, 23).ClearContents
          On Error GoTo 0
          Range(Range("A" & Target.Row), Range("F" & Target.Row)).Interior.ColorIndex = 8
        End If
    ElseIf Not Intersect(Target, Range("A3:A" & DerLig)) Is Nothing Then
        If Not IsDate(Target) Then
            Target = ""
            Range("B" & Target.Row).ClearContents
        End If
        Range("G" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))
        Range("A" & Target.Row) = IIf(Target = "", "", Application.Proper(Format(Target, "dddd dd mmmm yyyy")))
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub

Autres [RÉSOLU] Compléter la macro mais comment et où?

un internaute

XLDnaute Impliqué

gbinforme

XLDnaute Impliqué

un internaute

XLDnaute Impliqué

Discussions similaires

Autres [RÉSOLU] Compléter la macro mais comment et où?

un internaute

XLDnaute Impliqué

gbinforme

XLDnaute Impliqué

un internaute

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency