Avoir une formule dans une cellule et la possibilité de faire une entrée libre

[Fluxiflex]

Bonsoir le forum,

J'aimerai savoir s'il est possible d'avoir dans une même cellule un résultat fixe conditionné par la formule et une part variable.

Ci joint un tableau.

Merci de vos réponse.

 

[job75]

Re : Avoir une formule dans une cellule et la possibilité de faire une entrée libre

Bonsoir Fluxiflex,

Pour faire cela il faut du VBA et du coup plus besoin de formules, cette macro fait tous les calculs :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [F5:F9])
If Not r Is Nothing Then
  For Each r In r
    r(1, -1) = ""
    If r = "Ingénierie" Then r(1, -1) = r(1, 0) * 1100
    If r = "Facilitation" Then r(1, -1) = r(1, 0) * 900
    If r = "Information" Then r(1, -1) = r(1, 0) * 20
  Next
End If
Set r = Intersect(Target, [E5:E9])
If Not r Is Nothing Then
  For Each r In r
    If r(1, 2) = "Ingénierie" Then r(1, 0) = r * 1100
    If r(1, 2) = "Facilitation" Then r(1, 0) = r * 900
    If r(1, 2) = "Information" Then r(1, 0) = r * 20
  Next
End If
End Sub

La macro est à placer dans le code de la feuille (clic droit sur l'onglet et visualiser le code).

Fichier joint.

A+

 

[job75]

Re : Avoir une formule dans une cellule et la possibilité de faire une entrée libre

Re,

Il est bon d'empêcher que la plage D5: D9 soit modifiée (sauf si "Aucune" en colonne F) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Application.EnableEvents = False
Set r = Intersect(Target, [F5:F9])
If Not r Is Nothing Then
  For Each r In r
    r(1, -1) = ""
    If r = "Ingénierie" Then r(1, -1) = r(1, 0) * 1100
    If r = "Facilitation" Then r(1, -1) = r(1, 0) * 900
    If r = "Information" Then r(1, -1) = r(1, 0) * 20
  Next
End If
Set r = Intersect(Target, [E5:E9])
If Not r Is Nothing Then
  For Each r In r
    If r(1, 2) = "Ingénierie" Then r(1, 0) = r * 1100
    If r(1, 2) = "Facilitation" Then r(1, 0) = r * 900
    If r(1, 2) = "Information" Then r(1, 0) = r * 20
  Next
End If
Set r = Intersect(Target, [D5:D9])
If Not r Is Nothing Then
  For Each r In r
    If r(1, 3) = "" Then r = ""
    If r(1, 3) = "Ingénierie" Then r = r(1, 2) * 1100
    If r(1, 3) = "Facilitation" Then r = r(1, 2) * 900
    If r(1, 3) = "Information" Then r = r(1, 2) * 20
  Next
End If
Application.EnableEvents = True
End Sub

Fichier (2).

Edit : j'ai aussi ajouté une validation de données sur la plage E5:E9.

A+

 

[job75]

Re : Avoir une formule dans une cellule et la possibilité de faire une entrée libre

Re,

En fait on peut nettement simplifier le code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Intersect(Target, [D5:F9])
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r
  Set c = Cells(r.Row, "D")
  If c(1, 3) = "" Then c = ""
  If c(1, 3) = "Ingénierie" Then c = c(1, 2) * 1100
  If c(1, 3) = "Facilitation" Then c = c(1, 2) * 900
  If c(1, 3) = "Information" Then c = c(1, 2) * 20
Next
Application.EnableEvents = True
End Sub

Fichier (3).

Bonne nuit.

 

[job75]

Re : Avoir une formule dans une cellule et la possibilité de faire une entrée libre

Bonjour Fluxiflex, le forum,

On n'a pas non plus besoin de formule pour calculer les sommes :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, r As Range
Application.EnableEvents = False
Set P = [D5:F9] 'à adapter
Set r = Intersect(Target, P)
If Not r Is Nothing Then
  For Each r In r
    Set r = Intersect(r.EntireRow, P.Columns(1))
    If r(1, 3) = "" Then r = ""
    If r(1, 3) = "Ingénierie" Then r = r(1, 2) * 1100
    If r(1, 3) = "Facilitation" Then r = r(1, 2) * 900
    If r(1, 3) = "Information" Then r = r(1, 2) * 20
  Next
End If
P(P.Rows.Count + 1, 0) = "TOTAL"
P(P.Rows.Count + 1, 1) = Application.Sum(P.Columns(1))
P(P.Rows.Count + 1, 2) = Application.Sum(P.Columns(2))
Application.EnableEvents = True
End Sub

Fichier (4).

A+

 

[job75]

Re : Avoir une formule dans une cellule et la possibilité de faire une entrée libre

Re,

Si l'on veut pouvoir insérer des lignes, le plus simple est de nommer TOTAL la cellule C10 et d'utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, r As Range
Set P = [D5].Resize([TOTAL].Row - 5, 3)
Set r = Intersect(Target, P)
Application.EnableEvents = False
If Not r Is Nothing Then
  For Each r In Intersect(r.EntireRow, P.Columns(1))
    If r(1, 3) = "" Then r = ""
    If r(1, 3) = "Ingénierie" Then r = r(1, 2) * 1100
    If r(1, 3) = "Facilitation" Then r = r(1, 2) * 900
    If r(1, 3) = "Information" Then r = r(1, 2) * 20
  Next
End If
[TOTAL] = "TOTAL"
[TOTAL].Offset(, 1) = Application.Sum(P.Columns(1))
[TOTAL].Offset(, 2) = Application.Sum(P.Columns(2))
Application.EnableEvents = True
End Sub

La plage de référence P s'adapte toute seule.

Fichier (5).

A+