Bonjour @Dudu2Bonjour à tous,
@patricktoulon, 2 soucis dans ton code:
- tu limites la somme à la 1ère colonne de la sélection (il faudrait d'ailleurs que ce soit sur l'argument rng),
- tu testes et éventuellement totalises des valeurs de cellules, y compris celles qui sont filtrées.
Dans le Post #12, le code que j'ai finalement peu amendé pour traiter les 2 problèmes cités, garde le traitement des Areas qui permet de charger des tableaux sur lesquels est faite la somme. Ça ne change pas grand chose pour de petites sélections, je suis d'accord, mais mon utilisateur fait de grandes sélections avec des tonnes de valeurs numériques.
???????????????????- tu testes et éventuellement totalises des valeurs de cellules, y compris celles qui sont filtrées.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim adresse, som
som = RangeSomme(Selection, adresse)
MsgBox "Worksheet_SelectionChange Target = " & adresse & vbCrLf & " la somme est de " & som
End Sub
Function RangeSomme(rng As Range, adresse)
Dim somm#, rng2 As Range
For Each cel In Selection.Cells
If IsNumeric(cel) And Not IsDate(cel) And cel.EntireRow.Hidden = False Then
somm = somm + cel.Value
If rng2 Is Nothing Then Set rng2 = cel Else Set rng2 = Union(rng2, cel)
End If
Next
If Not rng2 Is Nothing Then adresse = rng2.Address(0, 0)
RangeSomme = somm
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, AutoFilter.Range) Is Nothing And Target.Count >= 1 And FilterMode Then
MsgBox "La somme est de : " & CellsSum(Target)
End If
Application.EnableEvents = True
End Sub
Function CellsSum(MyTarget As Range) As Double
Dim aSht As Worksheet, RngAF As Range, cell As Range
If MyTarget.Count = 1 Then
If IsNumeric(MyTarget.Value) And Not IsDate(MyTarget.Value) Then CellsSum = MyTarget.Value Else CellsSum = 0
Else
Set aSht = ActiveSheet
Set RngAF = aSht.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
Set RngAF = Intersect(RngAF, MyTarget.SpecialCells(xlCellTypeVisible)).Rows
For Each cell In RngAF.Cells
If IsNumeric(cell.Value) And Not IsDate(cell.Value) Then
CellsSum = CellsSum + cell.Value ' => supp. ; If Len(cell.Text) Then
End If
Next cell
' If Len(CellsSum) Then CellsSum = CellsSum => ligne supprimer
End If
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static sortir As Boolean
Dim rngVisible As Range, rngArea
If sortir Then Exit Sub
sortir = True: Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible): sortir = False
Set rngVisible = Intersect(Target, rngVisible)
If Not rngVisible Is Nothing Then
For Each rngArea In rngVisible.Areas
'...... ce qu'on veut ......
MsgBox rngArea.Address(0, 0)
Next rngArea
End If
End Sub
--- ou bien ---
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngVisible As Range, rngArea
Application.EnableEvents = False
Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
Application.EnableEvents = True
Set rngVisible = Intersect(Target, rngVisible)
If Not rngVisible Is Nothing Then
For Each rngArea In rngVisible.Areas
'...... ce qu'on veut ......
MsgBox rngArea.Address(0, 0)
Next rngArea
End If
End Sub
Non, je veux la somme du rng passé en argument, pas seulement de sa 1ère colonne comme dans ton code initial.tu veux la somme de toute les cellules de toutes les ligne visible ET!!!! toutes les colonnes c'est ça
Oui c'est le but. Mais je préfère passer par des tableaux des valeurs des Areas concernées pour faire la somme, que de tester et sommer cellule par cellule. Surtout si on inclut les cellules filtrées dans les tests. Les tableaux vont beaucoup plus vite.ben c'est le but non ??? c'est a dire exepter les cellules non visible sinon a quoi ça sert tout ce cinéma de specialcell et areas
'-----------------------------
'Somme des cellules d'un Range
'-----------------------------
Private Function SommeRange(ByVal Rng As Range) As Double
Dim TabValues() As Variant
Dim Area As Range
Dim Valeur As Variant
Dim Somme As Double
'Limite le Range à sommer
If Rng Is Nothing Then Exit Function
Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
If Rng Is Nothing Then Exit Function
'Cas particulier d'un Range d'une seule cellule
'La détection des Areas retourne toutes les lignes non filtrées de la feuille
If Rng.Cells.Count = 1 Then
If IsNumeric(Rng.Value) And Not IsDate(Rng.Value) Then SommeRange = Rng.Value
Exit Function
End If
'Pour éviter la génération spontanée d'un évènement Worksheet_SelectionChange()
'Voir https://www.excel-downloads.com/threads/vba-generation-spontanee-de-levenement-worksheet_selectionchange.20062934/
Application.EnableEvents = False
'Couvrir le dépassement de capacité
On Error GoTo DépassementCapacité
'On ne considère que les cellules non filtrées
For Each Area In Rng.SpecialCells(xlCellTypeVisible).Areas
If Area.Cells.Count = 1 Then
ReDim TabValues(1 To 1)
TabValues(1) = Area.Value
Else
TabValues = Area.Value
End If
For Each Valeur In TabValues
If IsNumeric(Valeur) And Not IsDate(Valeur) Then Somme = Somme + Valeur
Next Valeur
Next Area
'Return value
SommeRange = Somme
GoTo ExitFunction
DépassementCapacité:
SommeRange = 0
Beep
ExitFunction:
On Error GoTo 0
Application.EnableEvents = True
End Function
Oui je suis d'accord, c'est pour cela que j'ai proposé un code en post #17@RyuAutodidacte,
En effet on peut passer par une feuille temporaire. Mais c'est quand même plus lourd que d'y aller directement.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, AutoFilter.Range) Is Nothing And Target.Count >= 1 Then 'And FilterMode
MsgBox "La somme est de : " & CellsSum(Target)
End If
Application.EnableEvents = True
End Sub
Function CellsSum(MyTarget As Range) As Double
Dim aSht As Worksheet, RngAF As Range, cell As Range
If MyTarget.Count = 1 Then
If IsNumeric(MyTarget.Value) And Not IsDate(MyTarget.Value) Then CellsSum = MyTarget.Value Else CellsSum = 0
Else
Set aSht = ActiveSheet
Set RngAF = aSht.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
Set RngAF = Intersect(RngAF, MyTarget.SpecialCells(xlCellTypeVisible)).Rows
For Each cell In RngAF.Cells
If IsNumeric(cell.Value) And Not IsDate(cell.Value) Then
CellsSum = CellsSum + cell.Value
End If
Next cell
End If
End Function