VBA Changer le contenu de cellules par 1 autre

Bjr les VBAmans

Besoin de la procedure VBA pour:

Si la cellule A1=1 => changer toutes les cellules du classeur contenant =1*valid par =0*Valid

Merci à tous

JB

Bonjour

Procédure événementielle

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Address = "$A$1" Then
    If Range("A1") = 1 Then
      Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="1", replacement:="0", lookat:=xlPart
    Else
      Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="0", replacement:="1", lookat:=xlPart
    End If
  End If
End Sub

RE Banzai

Dsl mais ca ne fonctionne pas

Visiblement à cause de l'instruction Cells. spécialcells.....

je ne connais pas assez cette serie d'instruction pour résoudre

je te passe l'exemple que je cherche à résoudre, je compte sur toi car suis dans la muise !!

bien à toi

JB

Heureusement qu'avec les femmes je décode mieux qu'avec VBA

-- 13 Mai 2011, 20:08 --

rectif erreur sur mon fichier

il faut lire Cellules F3 F5 contenant =1*valid qui doivent passer à =0*valid si A1 passe à 1

et non = 1 Valid

merci

Bonjour

Peut-être

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
If Target.Offset(-2, 0).Value = 1 Then
Range("F3,F5").Select
Selection.FormulaR1C1 = "=0*Valid"
Range("A1").Select
End If
End If
End Sub

cordialement

Bonsoir

Il fallait préciser que le changement est suite à un calcul

Private Sub Worksheet_Calculate()
  If Range("$A$1") = 1 Then
    Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="1~*", replacement:="0*", lookat:=xlPart
  Else
    Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="0~*", replacement:="1*", lookat:=xlPart
  End If
End Sub

Mais la méthode de Amadéus est tout aussi efficace

re Banzai

ok ça fonctionne mais comme je le pensais tu rechangeais la formule si la cellule "A1" passait de 1 à 0 ce que je ne voulais pas, alors j'ai supprimé la ligne else... comme suit

Merci encore

JB

Private Sub Worksheet_Calculate()

If Range("$A$1") = 1 Then

Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="1~*", replacement:="0*", lookat:=xlPart

Else

End If

End Sub

-- 14 Mai 2011, 00:30 --

Re Amadéus

Parfait ca fonctionne et tu ne repositionnes pas à "=1*Valid" si la cellule A1 passe de 1 à 0 ce que je voulais

Par contre mon problème était de repositionner à "=0*valid" toutes les cellules de la feuille qui comporteraient "=1*Valid" et pas seulement une plage définie (F3:F5)

Bien que la procédure fournie par Banzai me donne satisfaction après supression d'une ligne je te serai infiniment reconnaissant pour ma formation si tu pouvais compléter ta procédure pour

Changer toutes les cellules comportant "1*valid" de la feuille

Ne pas utiliser la cellule A3 c'est la cellule A1 qui pilote A1 = 1 => Changer toutes les cellules

................................................................. A1 = 0 ne rien faire

Encore Merci

Cordialement

JB

-- 14 Mai 2011, 03:33 --

Re Banzai

Je me permet d'insister auprès de toi pour comprendre ta ligne qui te permet de définir les cellules contenant la formule =1*Valid

Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="1~*", replacement:="0*", lookat:=xlPart

J'ai passé 2 h pour essayer de comprendre merci de m'aider à ne pas mourrir béte !

Que devient ta ligne si je veux trouver les cellules contenant la formule =1*Calcu

merci

Cordialement

JB

-- 14 Mai 2011, 11:13 --

Re re l'ami Banzai

C'est ce que je craignais la ligne suivante ne selectionne pas de façon exclusive les cellules contenants

=1*Valid

Elle agit aussi sur des cellules =1*Calcu et d'autres...

Peux-tu sur ta procédure opérer à une selection exclusive de "=1*Valid et de "=0*valid" ?

Par avance merci, je cherche de mon coté...

Private Sub Worksheet_Calculate()

If Range("$A$1") = 1 Then

Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="1~*", replacement:="0*", lookat:=xlPart

Else

Cells.SpecialCells(xlCellTypeFormulas, 23).Replace what:="0~*", replacement:="1*", lookat:=xlPart

End If

End Sub

merci

probleme resolu voir la relance du 15 Mai

JB