XL 2013 VBA : Calculs automatiques en fonction des cellules complétées

MinstrelL · 7 Mars 2023

Bonjour,

Je n'arrive pas à me dépatouiller avec mes faibles compétences VBA...
Je voudrais automatiser un tableau de calculs de prix. Le but étant d'éviter d'écrire manuellement les SOUS TOTAUX et les SOMMES afin de gagner du temps.
Vous trouverez ci-joint un exemple dans un tableau Excel.
Je souhaiterais :

Lorsque je "crée" une Phase, le calcul de la cellule F1 se créer également.
Lorsque je "crée" une Sous-phase, le calcul de la cellule F2 se créer également.
Enfin, lorsque je complète les colonnes D et E dans une Sous-phase, le calcul des cellules adjacentes F3, F4 et F5 se créer également.

Aujourd'hui je complète tout manuellement, mais je souhaiterais que les calculs se "créer" automatiquement pour d'autres Phase et Sous-phase, comme la Phase 2 des lignes suivantes.
Par exemple, si j'écris Phase 3 dans la cellule A19 ainsi que ses Sous-phase, mes calculs se créer automatiquement

Je viens d'y penser en même temps que j'écris mon casse-tête, ça serait parfait s'il était possible d'ajouter facilement des montants en colonne D et E car le nombre de ligne par Sous-phase pourrait varier.

J'ai l'impression de demander un mini logiciel, mais si quelqu'un d'assez doué en VBA arrive à m'aider ça serait super !!

Merci beaucoup, je reste à l'écoute d'éventuelles questions.

Cordialement,

Paul

job75 · 7 Mars 2023

Bonjour MinstrelL, vgendron, JHA,

Avec 3 boutons comme vgendron mais un autre code :

VB:

Private Sub CommandButton1_Click() 'Phase
If Cells(ActiveCell.Row, 2) Like "Sous-phase*" Then Exit Sub
Dim n&
n = Application.CountIf(Range("A1:A" & ActiveCell.Row), "Phase*") + 1
With Cells(ActiveCell.Row, 1)
    With .Resize(, 6).Font
        .Size = 11
        .Bold = True 'gras
    End With
    .Value = "Phase " & n
End With
End Sub

Private Sub CommandButton2_Click() 'S.Phase
If ActiveCell.Row = 1 Then Exit Sub
If Cells(ActiveCell.Row, 1) Like "Phase*" Or Cells(ActiveCell.Row - 1, 2) Like "Sous-phase*" Then Exit Sub
Dim lig1&, lig, n&, x$
lig1 = Cells(ActiveCell.Row, 1).End(xlUp).Row
lig = Cells(ActiveCell.Row, 2).End(xlUp).Row
If lig < lig1...

vgendron · 7 Mars 2023

Hello

une proposition ici

JHA · 7 Mars 2023

Bonjour à tous,
Bonjour vgendron

Un essai par formule, les totaux et les sous-totaux sont en colonne "H"

JHA

vgendron · 7 Mars 2023

Hello @JHA

nouvelle version qui permet aussi d'ajouter une ligne dans la table
pour faire "simple" cette ligne est ajoutée en début de sous phase

job75 · 7 Mars 2023

Bonjour MinstrelL, vgendron, JHA,

Avec 3 boutons comme vgendron mais un autre code :

VB:

Private Sub CommandButton1_Click() 'Phase
If Cells(ActiveCell.Row, 2) Like "Sous-phase*" Then Exit Sub
Dim n&
n = Application.CountIf(Range("A1:A" & ActiveCell.Row), "Phase*") + 1
With Cells(ActiveCell.Row, 1)
    With .Resize(, 6).Font
        .Size = 11
        .Bold = True 'gras
    End With
    .Value = "Phase " & n
End With
End Sub

Private Sub CommandButton2_Click() 'S.Phase
If ActiveCell.Row = 1 Then Exit Sub
If Cells(ActiveCell.Row, 1) Like "Phase*" Or Cells(ActiveCell.Row - 1, 2) Like "Sous-phase*" Then Exit Sub
Dim lig1&, lig, n&, x$
lig1 = Cells(ActiveCell.Row, 1).End(xlUp).Row
lig = Cells(ActiveCell.Row, 2).End(xlUp).Row
If lig < lig1 Then lig = lig1
n = Val(Replace(Cells(lig, 2), "Sous-phase", "")) + 1
With Cells(ActiveCell.Row, 1)
    .Resize(, 6).Font.Size = 10 'RAZ
    .Resize(, 6).Font.Bold = False 'RAZ
    .Resize(, 7).Interior.Color = RGB(217, 217, 217) 'gris
    .Cells(1, 2) = "Sous-phase " & n
End With
For n = lig1 + 1 To ActiveCell.Row
    If Cells(n, 2) Like "Sous-phase*" Then x = x & "," & "F" & n
Next
Cells(lig1, 6) = "=SUM(" & Mid(x, 2) & ")"
End Sub

Private Sub CommandButton3_Click() 'Ligne
If Cells(ActiveCell.Row, 1) Like "Phase*" Or Cells(ActiveCell.Row, 2) Like "Sous-phase*" Then Exit Sub
Dim n&
n = Cells(ActiveCell.Row, 2).End(xlUp).Row
Cells(ActiveCell.Row, 1).Resize(, 7).Interior.Color = RGB(242, 242, 242) 'gris clair
Cells(n, 6) = "=SUBTOTAL(9," & Cells(n + 1, 6).Resize(ActiveCell.Row - n).Address(0, 0) & ")"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Targzt As Range)
CommandButton1.Top = ActiveCell.Top
CommandButton2.Top = ActiveCell.Top
CommandButton3.Top = ActiveCell.Top
End Sub

Edit : ajouté If ActiveCell.Row = 1 Then Exit Sub

A+

eriiic · 8 Mars 2023

Bonjour à tous,

sans formule ni vba, avec un Plan / Sous-total du menu Données
eric

MinstrelL · 8 Mars 2023

Bonjour à tous !

Tout d'abord merci beaucoup pour cette implication à trouver une solution à mon casse-tête.

J'ai bien essayé tous vos fichiers, je retiens en premier lieu celui de job75 et de eriiis (plus simple mais qui fonctionne aussi bien).
Merci beaucoup vgendron pour la bonne idée d'utiliser des boutons pour l'ergonomie du fichier et merci aussi à JHA pour ta proposition !

Je pense que je peux clore la discussion qui est un succès

XL 2013 VBA : Calculs automatiques en fonction des cellules complétées

MinstrelL

XLDnaute Nouveau

Pièces jointes

job75

vgendron

XLDnaute Barbatruc

Pièces jointes

JHA

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

eriiic

XLDnaute Barbatruc

Pièces jointes

MinstrelL

XLDnaute Nouveau

Discussions similaires