XL 2010 Effacer ou extraire valeurs dans Worksheet_Change [RESOLU]

cathodique

XLDnaute Barbatruc
Bonsoir,

J'ai besoin de votre aide. Avec cette macro, j'extrais des valeurs d'une feuille. jusque là ça va, je saisis un code en colonne A les cellules correspondantes se mettent à jour. Par contre je bloque, pour vider ces cellules quand je vide la cellule de la colonne A (NoMat).

En vous remerciant.
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim NoMat As Integer, Lcal As Integer, C As Range

    If Not Intersect(Range("A3:A17"), Target) Is Nothing Then
        Application.EnableEvents = False

        If IsNumeric(Target) = True And Target <> "" Then
            NoMat = Target.Value
            Lcal = Target.Row
            Set C = Sheets("Mat").[A:A].Find(NoMat, LookIn:=xlValues)

            If Not C Is Nothing Then
                Sheets("calcul").Range("C" & Lcal) = Sheets("Mat").Cells(C.Row, 3)  'denomination
                Sheets("calcul").Range("C" & Lcal + 1) = Sheets("Mat").Cells(C.Row, 4)  'fabricant
                Sheets("calcul").Range("C" & Lcal).Offset(, 3) = Sheets("Mat").Cells(C.Row, 5)    'densité
                Sheets("calcul").Range("C" & Lcal).Offset(, 5) = Sheets("Mat").Cells(C.Row, 6)  'absorption
            End If
        End If
    End If
    Application.EnableEvents = True
'                'si on efface le NoMat les valeurs s'effacent (le problème)
'                Sheets("calcul").Range("C" & Lcal) = ""  'denomination
'                Sheets("calcul").Range("C" & Lcal + 1) = "" 'fabricant
'                Sheets("calcul").Range("C" & Lcal).Offset(, 3) = ""   'densité
'                Sheets("calcul").Range("C" & Lcal).Offset(, 5) = ""  'absorption
            End If
End Sub
 

Si...

XLDnaute Barbatruc
Bonsoir

Tu commences par effacer puis tu remplis si …
VB:
Private Sub Worksheet_Change(ByVal R As Range)
  Dim L As Byte, C As Range
  If Not Intersect(R, [A3:A17]) Is Nothing And R.Count = 1 Then
    L = R.Row
    With Sheets("calcul")
      .Range("C" & L) = ""
      .Range("C" & L + 1) = ""
      .Range("C" & L)(1, 4) = ""
      .Range("C" & L)(1, 6) = ""
      If IsNumeric(R) And R <> "" Then
        Set C = Sheets("Mat").[A:A].Find(R, , , 1)
        If Not C Is Nothing Then
          .Range("C" & L) = Sheets("Mat").Cells(C.Row, 3)
          .Range("C" & L + 1) = Sheets("Mat").Cells(C.Row, 4)
          .Range("C" & L)(1, 4) = Sheets("Mat").Cells(C.Row, 5)
          .Range("C" & L)(1, 6) = Sheets("Mat").Cells(C.Row, 6)
        End If
      End If
    End With
  End If
End Sub
Au revoir
 

Si...

XLDnaute Barbatruc
re
upload_2017-2-27_23-6-2.gif

un raccourci que je prends souvent.
Tu veux ou tu veux pas ?
T’en veux ? T’en disposes à volonté !
T’en veux pas : je ne vais pas rouspéter !
 

cathodique

XLDnaute Barbatruc
Bonjour :), Lone-wolf, Si...

Merci à vous deux pour votre aide. Hélas, ça ne fonctionne pas pour l'effacement.

@Si..., merci pour le raccourci.

J'ai aussi essayé la proposition de Lone-wolf mais sans succès. Je me suis sûrement mal pris.

Je joins un petit fichier. Merci à vous. Bonne journée.
 

Pièces jointes

  • RemplacerIndexEquiv_EvenementChange.xlsm
    24 KB · Affichages: 36

Discussions similaires

Statistiques des forums

Discussions
312 922
Messages
2 093 644
Membres
105 774
dernier inscrit
Tibenjah