Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne ?

[ronanm]

Bonjour le forum,

Dans la recherche de formule vb, je ne trouve pas comment inscrire

if [B]cellule dans colonne B est effacée [/B]then 
(Range("A" & Target.Row).Value = ""
puis [B]supprimer fiche du même nom que la cellule [/B]*
End if

* la colonne A contient des numéros en lien avec des fiches de même nom, et l'idée serait de les supprimer en meme temps.

Cela fait donc deux questions.

Merci par avance pour votre aide.

Ronan

 

[Robert]

Re : Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne

Bonjour Ronanm, bonjour le forum,

Peut-ête comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim no As Scenario 'déclare la variable no (Nom de l'Onglet)

If Target.Columns <> 2 Then Exit Sub 'si le changemet a lieu ailleur que dans la colonne B, sort dela procédure
If Target.Cells.Count > 1 Then Exit Sub 'si plus d'une cellule sélectionnée, sort de la procédure

If Target.Value = "" Then 'condition : si la cellle st effacée
    no = Target.Offset(0, -1).Value 'définit le nom de l'onglet
    Target.Offset(0, -1).ClearContents 'supprime le contenu de la cellule de la colonne A
    On Error Resume Next 'gestion des erreurs (si l'onglet n'existe pas)
    Sheets(no).Delete 'supprime l'onglet
End If 'fin de la condition
End Sub

 

[ronanm]

Re : Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne

Merci pour cette réponse rapide,

Je teste ça tout de suite et vous retiens au courant !!

Ronan

 

[ronanm]

Re : Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne

Re,

je viens d'essayer

If Target.Columns <> 12 Then Exit Sub 'si le changemet a lieu ailleur que dans la colonne B, sort dela procédure
If Target.Cells.Count > 1 Then Exit Sub 'si plus d'une cellule sélectionnée, sort de la procédure

mais il ne se passe rien lorsque je supprime en colonne 12 (appelée B dans ma question)

Du coup, j'ai basculer avec :

If Not Intersect(Target, Range(Range("L:L"))) Is Nothing Then
If Range("L" & Target.Row) = "" Then
no = Target.Offset(0, -2).Value
On Error Resume Next
Sheets(no).Delete
Target.Offset(0, -2).ClearContents
Exit Sub
End If
End If

Résultat, la feuille se supprime bien mais ce n'est pas celle qui porte le nom (1, 2 ou 3) mais c'est la premiere, deuxième ou troisième feuille du classeur qui s'efface !!

Merci de votre aide.

Ronan

 

[Robert]

Re : Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne

Bonsoir Ronan. bonsoir le forum,

Oui c'est normal ! Un erreur c'était glissé avec la texte automatique de VBE. Il fallait déclarer la variable no comme texte (String) et non pas comme Scenario...

Dim no As String

Et pour assurer modifier :

no = CStr(Target.Offset(0, -2).Value)

Ça devrait fonctionner correctement.

 

[ronanm]

Re : Si valeur cellule effacée alors effacer donnée dans une colonne de la meme ligne

Bonjour Robert,
je viens de tester tout cela :

Dim no As String 'déclare la variable no (Nom de l'Onglet)

If Target.Columns <> 12 Then Exit Sub 'si le changemet a lieu ailleur que dans la colonne B, sort dela procédure
If Target.Cells.Count > 1 Then Exit Sub 'si plus d'une cellule sélectionnée, sort de la procédure

If Target.Value = "" Then 'condition : si la cellle st effacée
  no = CStr(Target.Offset(0, -2).Value) 'définit le nom de l'onglet
    Target.Offset(0, -2).ClearContents 'supprime le contenu de la cellule de la colonne A
    On Error Resume Next 'gestion des erreurs (si l'onglet n'existe pas)
    Sheets(no).Delete 'supprime l'onglet
End If 'fin de la condition

Mais rien ne se passe !!

Peut-etre est ce du a ce code bidouillé suivant ??

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim msg As String, Style As String, Title As String, Answer As String
Dim msg2 As String, Style2 As String, Title2 As String, Answer2 As String
Dim msg3 As String, Style3 As String, Title3 As String, Answer3 As String
Dim Colonne As Integer
Dim Adresse As String


'-----------------------------------
'Etape 1 : x en majuscule
'-----------------------------------
If Range("L" & Target.Row) = "x" Or Range("M" & Target.Row) = "x" Or Range("K" & Target.Row) = "x" Or Range("N" & Target.Row) = "x" Or Range("O" & Target.Row) = "x" Or Range("P" & Target.Row) = "x" Then
 Target.Value = UCase(Target.Value)
  Exit Sub
End If

'-----------------------------------
'Etape 2 : si x demander de créer une fiche et un numéro
'-----------------------------------

 Select Case Target.Column
    Case 12:
      If Target.Value = "X" Then
         
      msg = ("Point réglementaire à améliorer !" & vbCr & "" & vbCr & _
      "Pour valider ce point et créer une fiche de constat 'A AMELIORER' ? cliquez sur 'Oui'") ' Définit le message.
      Style = vbYesNo + vbQuestion
      Title = "A Améliorer"    ' Définit les titres.
      Answer = MsgBox(msg, Style, Title)
        If Answer = vbYes Then
           Fiche = Application.InputBox("Entrer un numéro de fiche ?" & vbCr & "" & vbCr & "Dernier numéro de fiche utilisé : " & Range("U8").Value, Type:=1)
                If Fiche = False Then
                    Target.Value = ""
                    Range("J" & Target.Row) = ""
                    Target.Select
                    Exit Sub
                End If
            Range("J" & Target.Row).Value = Fiche
        End If
            
        If Answer = vbNo Then
            Target.Value = ""
            Range("J" & Target.Row) = ""
            Target.Select
            Exit Sub
            End If
       End If
     
   Case 13:
      If Target.Value = "X" Then
      msg2 = ("Point réglementaire non conforme !" & vbCr & "" & vbCr & _
      "Pour valider ce point et créer une fiche de constat 'NON CONFORME' ? cliquez sur 'Oui'") ' Définit le message.
      Style2 = vbYesNo + vbQuestion
      Title2 = "Non-Conforme"    ' Définit les titres.
      Answer2 = MsgBox(msg2, Style2, Title2)
             If Answer2 = vbYes Then
             Fiche = Application.InputBox("Entrer un numéro de fiche ?" & vbCr & "" & vbCr & _
            "Dernier numéro de fiche utilisé : " & Range("U8").Value, Type:=1)
                If Fiche = False Then
                Target.Value = ""
                Range("J" & Target.Row) = ""
                Target.Select
                Exit Sub
                End If
              Range("J" & Target.Row).Value = Fiche
 
             End If
             If Answer2 = vbNo Then
             Target.Value = ""
             Range("J" & Target.Row) = ""
             Target.Select
             End If
      End If
End Select


'-----------------------------------
'Etape 3 : si N°, vérifie si doublon puis ou est le x et crée une fiche AA ou NC
'-----------------------------------


If Not Intersect(Target, Range("J:J ")) Is Nothing Then
   On Error Resume Next
   If Target.Count > 1 Then Exit Sub 'On sort si plus d'une cellule a été modifiée
   If Target.Value = "" Then Exit Sub 'On sort si la cellule modifiée est vide
   Colonne = 10  'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)

          If Target.Column = Colonne Then 'Vérifie si c'est la colonne cible a été modifiée
            Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address 'Recherche si la nouvelle donnée existe déjà dans la colonne.
                    If Adresse <> Target.Address Then  'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela signifie qu'il y a un doublon dans la colonne.
                        MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
                        'Suppression de la donnée
                        Range("J" & Target.Row) = ""
                        ' puis redemande numéro
                        Fiche = Application.InputBox("Entrer un numéro de fiche ?" & vbCr & "" & vbCr & _
                        "Dernier numéro de fiche utilisé : " & Range("U8").Value, Type:=1)
                            If Fiche = False Then ' si saisi annuler
                            Target.Value = ""
                            Range("J" & Target.Row) = ""
                            Target.Select
                            Exit Sub
                            End If
                    Range("J" & Target.Row).Value = Fiche ' si ok insère le numéro
             
             End If
        End If
  '  On Error Resume Next
    If Range("L" & Target.Row) = X Then
    trameNC 'cf module 1
    Exit Sub
    End If
    If Range("M" & Target.Row) = X Then
    AA 'cf module 1
    Exit Sub
    End If
End If

'------------------------------------------------------------
'pour supprimer feuille. pb supprime la première feuille !!!
'------------------------------------------------------------

Dim no As String 'déclare la variable no (Nom de l'Onglet)

If Target.Columns <> 12 Then Exit Sub 'si le changemet a lieu ailleur que dans la colonne B, sort dela procédure
If Target.Cells.Count > 1 Then Exit Sub 'si plus d'une cellule sélectionnée, sort de la procédure

If Target.Value = "" Then 'condition : si la cellle st effacée
  no = CStr(Target.Offset(0, -2).Value) 'définit le nom de l'onglet
    Target.Offset(0, -2).ClearContents 'supprime le contenu de la cellule de la colonne A
    On Error Resume Next 'gestion des erreurs (si l'onglet n'existe pas)
    Sheets(no).Delete 'supprime l'onglet
End If 'fin de la condition
End Sub

Bien à vous.