Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Insérer SOUSTOTAL (vba) sur une plage filtrée

Insérer SOUSTOTAL (vba) sur une plage filtrée

3 réponses
Avatar
bipolaris
Bonjour

Je cherche comment faire pour insérer en vba sur un filtre élaboré
un soustotal en vba
dans la première ligne vide sous le filtre
Un fois l'insertion effectuée, définir comme zone d'impression le
resultat
du filtre plus la ligne insérée contenan les SOUS.TOTAUX

Voila en j'en suis
Dim Rx2, Rx3, Rx4 As Range
Dim LRw As Long
If WorksheetFunction.CountA(Cells) > 0 Then
LRw = Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
X = LRw + 1
End If

Set Rx2 = Range("A2", "A" & X - 1)
Set Rx3 = Range("B2", "B" & X - 1)
Set Rx4 = Range("C2", "C" & X - 1)
With ActiveSheet.Range("A2").CurrentRegion
.AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:=Range("critere"), Unique:=False
End With

Cells(X, 1) = "=SUBTOTAL(9," & Rx2.Address & ")"
Cells(X, 2) = "=SUBTOTAL(9," & Rx3.Address & ")"
Cells(X, 3) = "=SUBTOTAL(9," & Rx4.Address & ")"

Set Rx2 = Nothing: Set Rx3 = Nothing: Set Rx4 = Nothing
End Sub

Y-a t'il un moyen de simplifier le code?
(Ce j'essaye de faire se resume à:
filtrer des données avec comme critère la date du jour (filtre
élaboré)
ajouter le total du jour (ici avec SOUS.TOTAL)
imprimer le resultat du filtre et du total (avec un entete bas de page
predefini en vba)
restaurer la feuille filtrée dans son état initial
(ShowAllSata et suppresion de la ligne des TOTAUX)

Merci à ceux qui pourront m'aider
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Herdet
Bonsoir jmg,
Tu peux résoudre ce pb en quelques lignes en utilisant la fonction SOMME.SI
de la feuille de calcul
Sub SousTotauxDate()
'---- dernière ligne de données + 2
m = Range("A50000").End(xlUp).Row + 2
' copie dans colonnes B, C, D des formules de SOMME.SI(colonne A,
Aujourd'hui, total de la colonne active)
Range("B" & m & ":D" & m).FormulaR1C1 = "=SUMIF(C1,TODAY(),C)"
' impression des données et sommes
'.........
' effacement de la ligne des totaux
Rows(m).ClearContents
End Sub
Cordialement
Robert Dezan

"jmg" a écrit dans le message de news:

Bonjour

Je cherche comment faire pour insérer en vba sur un filtre élaboré
un soustotal en vba
dans la première ligne vide sous le filtre
Un fois l'insertion effectuée, définir comme zone d'impression le
resultat
du filtre plus la ligne insérée contenan les SOUS.TOTAUX

Voila en j'en suis
Dim Rx2, Rx3, Rx4 As Range
Dim LRw As Long
If WorksheetFunction.CountA(Cells) > 0 Then
LRw = Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
X = LRw + 1
End If

Set Rx2 = Range("A2", "A" & X - 1)
Set Rx3 = Range("B2", "B" & X - 1)
Set Rx4 = Range("C2", "C" & X - 1)
With ActiveSheet.Range("A2").CurrentRegion
.AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:=Range("critere"), Unique:úlse
End With

Cells(X, 1) = "=SUBTOTAL(9," & Rx2.Address & ")"
Cells(X, 2) = "=SUBTOTAL(9," & Rx3.Address & ")"
Cells(X, 3) = "=SUBTOTAL(9," & Rx4.Address & ")"

Set Rx2 = Nothing: Set Rx3 = Nothing: Set Rx4 = Nothing
End Sub

Y-a t'il un moyen de simplifier le code?
(Ce j'essaye de faire se resume à:
filtrer des données avec comme critère la date du jour (filtre
élaboré)
ajouter le total du jour (ici avec SOUS.TOTAL)
imprimer le resultat du filtre et du total (avec un entete bas de page
predefini en vba)
restaurer la feuille filtrée dans son état initial
(ShowAllSata et suppresion de la ligne des TOTAUX)

Merci à ceux qui pourront m'aider


Avatar
bipolaris
Bonjour

Merci de ton aide
Les cellules filtrées doivent apparaitrent à l'impression
(uniquement celles de la date du jour)
+ la somme de ces cellules ( somme pour chaque colonne)
SousTotauxDate() rélise bien le total
mais comme il n'y a pas de filtre
à l'impression tout apparait
Avatar
JMG
Bonjour

Voici ou j'en suis actuellement:
Y-a-t'il moyen d'avoir un code plus concis?
Sub FiltreDate5()
Application.ScreenUpdating = False
lJr = Format(Date, "dd/mm/yy")
With Worksheets("Feuil1")
.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=lJr,
Operator:=xlAnd
End With
Dim DerLig As Long
DerLig = ActiveSheet.Range("A65536").End(xlUp).Row
With ActiveSheet
.Cells(DerLig + 1, "B").Formula = "=SUBTOTAL(9,B1:B" & DerLig & ")"
.Cells(DerLig + 1, "D").Formula = "=SUBTOTAL(9,D1:D" & DerLig & ")"
.Cells(DerLig + 1, "E").Formula = "=SUBTOTAL(9,E1:E" & DerLig & ")"
.Cells(DerLig + 1, "F").Formula = "=SUBTOTAL(9,F1:F" & DerLig & ")"
.Cells(DerLig + 1, "A").Value = "TOTAUX"
'Mise en page et entête prédéfini
.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
'lignes de mise en page
End With
'Mise en forme ligne TOTAUX
With Range(Cells(DerLig + 1, 1), Cells(DerLig + 1, 6))
.Font.Bold = True
.Interior.ColorIndex = 15
.Borders.LineStyle = xlDouble
End With
'Impression
.PrintPreview
End With
'Suppression du filtre automatique et la ligne des TOTAUX
Selection.AutoFilter
Rows(DerLig + 1).Clear
Application.ScreenUpdating = True
End Sub