Formule en VBA

Le 28/04/2016 à 11:48

Bonjour

J'ai une formule dans une feuille en colonne "E" que j'aimerai passé par le VBA. Ma Formule;

=SI(NON(ESTVIDE(G229));"DCD";SI(ESTVIDE(D229);"";DATEDIF(D229;AUJOURDHUI();"y")&" Ans"))

en sachant que j'ai déjà un code dans la même feuille qui est;

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, n&, a$(), x$, y$
  Set r = Intersect(Target, [D:G], Me.UsedRange)
  If r Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each r In r 'si entrées multiple (copier-coller)
    n = n + 1
    ReDim Preserve a(1 To 2, 1 To n)
    x = CStr(r.Value2)
    If IsNumeric(x) Then
      y = Format(x, "#0\/00\/0000")
      If (x Like "#######" Or x Like "########") And IsDate(y) Then
        a(1, n) = r.Address
        a(2, n) = Format(y, "m/d/yyyy")
      Else
        Application.Undo 'annulation
        GoTo 1
      End If
    End If
  Next
  For n = 1 To UBound(a, 2)
    If a(1, n) <> "" Then
      With Range(a(1, n))
        .Value = a(2, n)
        If Not IsNumeric(.Value2) Then .Value = "" 'autre cas d'annulation
      End With
    End If
  Next
  1 [D:G].NumberFormat = "dd/mm/yyyy" 'format modifiable
  Application.EnableEvents = True
  End Sub

Je vous remercie de votre aide

Cordialement

Max

Le 28/04/2016 à 12:45

Hello valmax,

Alors que fait ton code en terme d’exécution? Il bug ou bien il ne renvoi aucune valeur?

Cordialement.

Le 28/04/2016 à 14:57

Salut nonesofar13

Non le code VBA fonctionne très bien mais j'aimerai mettre ma formule en code VBA

@+

max

Le 29/04/2016 à 09:35

Bonjour

Le 29/04/2016 à 09:50

Hello, 8)

Si c'est ne mettre que la formule dans le code vba, il suffit de sélectionner la cellule, lancer l'enregistreur de macro, double cliquer dans la cellule contenant une formule et le code de la formule remonte en VBA.

ActiveCell.FormulaR1C1 = "=IF(NOT(ISBLANK(R[228]C[6])),""DCD"",IF(ISBLANK(R[228]C[3]),"""",DATEDIF(R[228]C[3],TODAY(),""y"")&"" Ans""))"

Tu peux remplacer les variables adresses activecell, R[228]C[6] par des variables dynamiques.

R[228]C[6] c'est le format d'adresse anglo de mémoire ligne/colonne tu peux mettre une variable ou une adresse range() à la place.

Le 29/04/2016 à 10:08

Hello,

A vraiment pas mal cette technique pour transformer une formule !! J'avais galéré pour traduire une formule en vba une fois ça va me servir à l'avenir cette technique.

Après il peut mettre la formule dans une boucle pour l’étirer automatiquement comme ça.

Sub test()
Dim LastLig As Long

With Sheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("B1:B" & LastLig).Formula = "=IF(NOT(ISBLANK(G229)),""DCD"",IF(ISBLANK(D229),"""",DATEDIF(D229,TODAY(),""y"")&"" Ans""))"
End With
End Sub
Le 29/04/2016 à 10:46

yep pas mal, d'ailleurs pour précisions de mon code, y'a 6 propriétés formula pour l'objet range pour résumer :

Formula => formule avec adresse type A1

FormulaR1C1 => formule avec adresse type R1C1

C'est dans l'aide VBA d'office

Le 29/04/2016 à 11:05

Bonjour et merci a tous

Voila pour cette formule en VBA sa fonctionne avec se code/

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim P As Range, r As Range, n&, a$(), x$, y$
 Set P = Intersect(Target, [D:G], Me.UsedRange)
 If P Is Nothing Then Exit Sub
 Application.EnableEvents = False
 For Each r In P 'si entrées multiple (copier-coller)
   n = n + 1
   ReDim Preserve a(1 To 2, 1 To n)
   x = CStr(r.Value2)
   If IsNumeric(x) Then
     y = Format(x, "#0\/00\/0000")
    If (x Like "#######" Or x Like "########") And IsDate(y) Then
       a(1, n) = r.Address
       a(2, n) = Format(y, "m/d/yyyy")
     Else
       Application.Undo 'annulation
       GoTo 1
     End If
   End If
 Next r
 For n = 1 To UBound(a, 2)
   If a(1, n) <> "" Then
     With Range(a(1, n))
       .Value = a(2, n)
       If Not IsNumeric(.Value2) Then .Value = "" 'autre cas d'annulation
     End With
   End If
 Next n

 With Intersect(P.EntireRow, [E:E])
   .FormulaR1C1 = "=IF(NOT(ISBLANK(RC7)),""DCD"",IF(ISNUMBER(RC4),DATEDIF(RC4,TODAY(),""y"")&"" ans"",""""))"
   For Each r In .Areas
     r = r.Value 'supprime les formules
   Next r
 End With

1  [D:G].NumberFormat = "dd/mm/yyyy" 'format modifiable
 Application.EnableEvents = True
 End Sub

Mais j'ai une deuxième formule en colonne "H" qui est ceci

=SI(NB(D229:G229)=2;"Décéder à l’âge de : "&DATEDIF(D229;G229;"y")&" an"&REPT("s";DATEDIF(D229;G229;"y")>1);"")

Est je n'arrive pas à la faire fonctionner.

Bonne journée

Max

22essaie-formule.xlsm (221.25 Ko)
Le 29/04/2016 à 17:10

je pense que ce sont tes définitions des variables x et y qui font planter ta formule dans H, car même si je rentre une date valide, en l'état je retourne systématiquement sur la ligne application.undo qui m'annule la valeur entrée.

Si Y sert à vérifier la validité du format date je pense que tu devrais faire comme ça :

y = Format(Target.Value, "dd/mm/yyyy")

Quant au test de la variable X : x Like "#######" Or x Like "########"), je ne vois pas son utilité, cela fait retourner systématiquement sur annulation d'entrée, si c'est pour vérifier le format numérique tu la déjà fait ici : If IsNumeric(x) Then

Moi je propose de remplacer cette partie :

   If IsNumeric(x) Then
     y = Format(x, "#0\/00\/0000")
    If (x Like "#######" Or x Like "########") And IsDate(y) Then
       a(1, n) = r.Address
       a(2, n) = Format(y, "m/d/yyyy")
     Else
       Application.Undo 'annulation
      GoTo 1
     End If
   End If
 Next r

Par ça :

 Dim P As Range, r As Range, n&, a$(), x$, y$
 Set P = Intersect(Target, [D:G], Me.UsedRange)
 If P Is Nothing Then Exit Sub
 If Target.Value = Empty Then Exit Sub '<< si user supprime la donnée pas de contrôle de calcul sort direct permet de supprimer la valeur
 Application.EnableEvents = False
 For Each r In P 'si entrées multiple (copier-coller)
   n = n + 1
   ReDim Preserve a(1 To 2, 1 To n)
   x = CStr(r.Value2)
   If IsNumeric(x) Then
     y = Format(Target.Value, "dd/mm/yyyy")
    If IsDate(y) = True And y < CDate(Now) Then
       a(1, n) = r.Address
       a(2, n) = Format(y, "m/d/yyyy")
     Else
       Application.Undo 'annulation
       GoTo 1
     End If
     Else
   Application.Undo 'annulation
   GoTo 1
   End If
 Next r

... reste du code non modifié

Déjà ça n'annule plus systématiquement la date entrée, si la date est supérieur à aujourd'hui ça reporte sur annulé, si ce n'est pas numérique aussi.

Le 29/04/2016 à 18:36

Re,

J'ai fait comme tu me le suggérer mais j'ai un message d'erreur "Déclaration existante dans la porté en cours" sur la ligne

Dim P As Range, r As Range, n&, a$(), x$, y$

@+

Max

Le 29/04/2016 à 18:43

code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim P As Range, r As Range, n&, a$(), x$, y$

Set P = Intersect(Target, [D:G], Me.UsedRange)

If P Is Nothing Then Exit Sub

If Target.Value = Empty Then Exit Sub '<< si user supprime la donnée pas de contrôle de calcul sort direct permet de supprimer la valeur

Application.EnableEvents = False

For Each r In P 'si entrées multiple (copier-coller)

n = n + 1

ReDim Preserve a(1 To 2, 1 To n)

x = CStr(r.Value2)

If IsNumeric(x) Then

y = Format(Target.Value, "dd/mm/yyyy")

If IsDate(y) = True And y < CDate(Now) Then

a(1, n) = r.Address

a(2, n) = Format(y, "m/d/yyyy")

Else

Application.Undo 'annulation

GoTo 1

End If

Else

Application.Undo 'annulation

GoTo 1

End If

Next r

For n = 1 To UBound(a, 2)

If a(1, n) <> "" Then

With Range(a(1, n))

.Value = a(2, n)

If Not IsNumeric(.Value2) Then .Value = "" 'autre cas d'annulation

End With

End If

Next n

With Intersect(P.EntireRow, [E:E])

.FormulaR1C1 = "=IF(NOT(ISBLANK(RC7)),""DCD"",IF(ISNUMBER(RC4),DATEDIF(RC4,TODAY(),""y"")&"" ans"",""""))"

For Each r In .Areas

r = r.Value 'supprime les formules

Next r

End With

1 [D:G].NumberFormat = "dd/mm/yyyy" 'format modifiable

Application.EnableEvents = True

End Sub

+ PJ et dis nous

15copie-de-essaie-formule-4.xlsm (226.50 Ko)
Le 29/04/2016 à 18:58

Oui sa fonctionne

Mais ma formule dans la colonne "H" comment la rentré?

=SI(NB(D229:G229)=2;"Décéder à l’âge de : "&DATEDIF(D229;G229;"y")&" an"&REPT("s";DATEDIF(D229;G229;"y")>1);"")

@+

Le 29/04/2016 à 19:16

1 lancer l'enregistreur de macro > 2 sélectionner une cellule dans la colonne H ayant la formule > 3 double cliquer dans la cellule > 4 faire entrer > 5 arrêter l'enregistreur > 6 aller dans le developeur vba et y'aura la formule en code VBA

Voilà ce qui ressort en brut format adresse anglo R1C1

ActiveCell.FormulaR1C1 = "=IF(COUNT(RC[-4]:RC[-1])=2,""Décéder à l’âge de : ""&DATEDIF(RC[-4],RC[-1],""y"")&"" an""&REPT(""s"",DATEDIF(RC[-4],RC[-1],""y"")>1),"""")"

format adresse A1 (à faire en manuel :

ActiveCell.Formula = "=IF(COUNT(range(""D195:G195""))=2,""Décéder à l’âge de : ""&DATEDIF(range(""D195""),range(""G195""),""y"")&"" an""&REPT(""s"",DATEDIF(range(""D195""),range(""G195""),""y"")>1),"""")"

Rechercher des sujets similaires à "formule vba"