Mettre formule de calcul Excel dans une macro VBA

Version imprimable

Bonjour à tous,

Dans un tableau Excel dans toutes les cellule de la colonne L j'ai cette formule de calcul. J'aimerai faire passer celle-ci dans une macro afin qu'il n'y ait aucune formule dans mon tableau. Cela a pour but surtout d'éviter que les formules soient effacées par les utilisateurs. Je ne peux pas protéger les cellules pour des raisons pratiques.
Cette formule est liée au code ci-après. Est-il possible de faire une macro que je mettrais dans ThisWorkBook, car la macro servirait à toutes les feuilles du classeur, soit 6 feuilles. La formule doit être étendue aux 116 cellules de chaque feuille
Merci par avance pour l'aide que vous pourrez m'apporter.
Bien amicalement
Code:

1 2 3 'Voici la formule en L =SI(K4=0;"";SI(A4="";"";titreprix2($K4;$K$4:$K$120)))
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 'Code dans un module Function TitrePrix2(Resultat As Double, ResultatsLaureats As Range) As String 'résultat est la valeur à tester 'ResultatsLaureats est l'ensemble des résultats à évaluer en vue de connaitre le grand gagnant 'résultat de base pour la Teurgoule Select Case Fix(Resultat) Case Is < 44.99 TitrePrix = "Mention Encouragement des Jurats" Case 45 To 52.99 TitrePrix = "Mention d'Honneur" Case 53 To 56.99 TitrePrix = "Grand Prix Régional" Case 57 To 59.99 TitrePrix = "Premier Prix National" Case 60 To 70 TitrePrix = "Grand Prix National" End Select 'est-ce le meilleur résultat? 'si oui, c'est un gaillard ce lascar! If Application.WorksheetFunction.Max(ResultatsLaureats) = Resultat And Resultat > 61 Then TitrePrix = "TEURGOULE D'OR" If Application.WorksheetFunction.Max(ResultatsLaureats) = Resultat And Resultat = 61 Then TitrePrix = "TEURGOULE D'OR" End Function

05/09/2016, 11h04
Jean-Philippe André

Salut,

pour qu'une formule soit visible dans les cellules, on passe par un module, et on applique une portee Public a la fonction =].

Du coup tu ne veux pas de formules dans les cellules, mais comment faire appel aux fonctions ?

Un clic bouton ?

Bonjour et merci pour ta réponse. La formule se déclenche lorsqu'une lettre est tapée dans la cellule A2. Voir l'exemple ci-dessous

Code:

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate() 'à l'ouverture de la feuille, le lettre E se met dans la cellule A2
If Range("A2") = "" Then
Range("A2").Select
    ActiveCell.FormulaR1C1 = "E"
    Range("A3").Select
Else
Range("A3").Select
End If
End Sub

Une fois que la lettre (pas toujours la même) est inscrite en A2, elle déclenche cette autre macro. Donc ma formule doit se mettre en action en même temps.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long, NewLig As Long, Nb As Long
If Target.Address = "$A$2" Then
   Union(Range("A4:K" & Rows.Count), Range("M4:M" & Rows.Count)).ClearContents
   If Target <> "" Then
      With Sheets("Général")
        .Range("A3").AutoFilter
         LastLig = .Cells(Rows.Count, "G").End(xlUp).Row
         If LastLig < 4 Then
         If .Range("A3").AutoFilter = True Then .Range("A3").AutoFilter
         Exit Sub
         End If
         With .Range("A3:N" & LastLig)
            .AutoFilter
            .AutoFilter field:=7, Criteria1:=Target
         End With
         Nb = .Range("A3:A" & LastLig).SpecialCells(xlCellTypeVisible).Count - 1
         If Nb > 0 Then
            Application.EnableEvents = False
            .Range("A4:F" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("A4")
            .Range("I4:J" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("G4")
            .Range("L4:M" & LastLig).SpecialCells(xlCellTypeVisible).Copy
            Range("J4").PasteSpecial xlPasteValues
            Range("I4").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            Application.EnableEvents = True
         End If
         .Range("A3").AutoFilter
        Range("A3").Select
      End With
      Range("A3").Select
    ActiveWorkbook.Worksheets("J").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("J").Sort.SortFields.Add Key:=Range("K4:K299"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("J").Sort.SortFields.Add Key:=Range("B4:B299"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("J").Sort
        .SetRange Range("A3:L500")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A3").Select
   End If
End If
AutoFitSheet
End Sub

J'ai essayé de faire ça à la suite du code déjà écrit mais ça ne fonctionne pas.

Code:

1
2
3
4
5
6
7
8
9
10
11
If Nb > 0 Then
            Application.EnableEvents = False
            .Range("A4:F" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("A4")
            .Range("I4:J" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("G4")
            .Range("L4:M" & LastLig).SpecialCells(xlCellTypeVisible).Copy
            Range("J4").PasteSpecial xlPasteValues
            Range("I4").PasteSpecial xlPasteValues
Range ("L4:L120").Formula = "=If(K4=0;"";If(A4="";"";titreprix2($K4;$K$4:$K$120)))"
            Application.CutCopyMode = False
            Application.EnableEvents = True
         End If

05/09/2016, 17h44
Jean-Philippe André

Le separateur lorsque tu ecris une formula est un "," et non ";"

Code:

Range ("L4:L120").Formula = "=If(K4=0,"",If(A4="","",titreprix2($K4,$K$4:$K$120)))"
05/09/2016, 18h06
Marc-L

Bonjour,

qui plus est chaque guillemet au sein d'une chaîne de caractères doit être doublé !
Et la formule peut rester en français via la propriété FormulaLocal …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …
05/09/2016, 19h54
NEC14

Merci pour vos réponses.
Bien amicalement