compter Nombre de cellule dans une zone

Salut,


Il faut sélectionner la zone puis lancer la macro suivante:

Sub compteCelluleZone()
Dim objRange As Range
Dim objCell As Range
Dim lngNbrCell As Long
Dim lngNbrFusion As Long
Dim booFusion As Boolean

Set objRange = Application.Selection
lngNbrCell = 0
lngNbrFusion = 0
For Each objCell In objRange.Cells

If objCell.MergeCells Then
If Not booFusion Then
lngNbrFusion = lngNbrFusion + 1
booFusion = True
End If
Else
lngNbrCell = lngNbrCell + 1
booFusion = False
End If
Next
MsgBox "Résultat : " & lngNbrCell + lngNbrFusion
End Sub

Ceci en considérant que les cellules ne sont fusionnées que sur des
lignes et non sur des colonnes

A+

Rv

"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%239QxHopYEHA.2736@TK2MSFTNGP10.phx.gbl...

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex:
A1:D10).

Il faut que le cellule fusionnées ne compte que pour une case. quelqu'un
a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je
n'ai

pas pas de cellule fusionnée qui sont sur des lignes différentes)

Re,

La même en plus général: les fusions peuvent être quelconques:

Sub compteNombreCellules()
Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In objRange.Cells
' Si on est sur une cellule fusionnée
If objCell.MergeCells Then
' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next
' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next
MsgBox "Résultat : " & lngNbrCell
End Sub

A+

Rv


"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%239QxHopYEHA.2736@TK2MSFTNGP10.phx.gbl...

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex:
A1:D10).

Il faut que le cellule fusionnées ne compte que pour une case. quelqu'un
a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je
n'ai

pas pas de cellule fusionnée qui sont sur des lignes différentes)

Petite précision importante : le module dans lequel on insère cette
procédure doit commencer par l'instruction
Option Base 1
pour préciser que le premier élément des tableaux est l'indice 1 et non 0
comme par défaut.

A+

Rv

"Rv" <herve.pinardPASDESPAM@free.fr> a écrit dans le message de
news:uOMWtmqYEHA.2840@TK2MSFTNGP11.phx.gbl...

Re,

La même en plus général: les fusions peuvent être quelconques:

Sub compteNombreCellules()
Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In objRange.Cells
' Si on est sur une cellule fusionnée
If objCell.MergeCells Then
' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next
' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next
MsgBox "Résultat : " & lngNbrCell
End Sub

A+

Rv


"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%239QxHopYEHA.2736@TK2MSFTNGP10.phx.gbl...

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex:
A1:D10).

Il faut que le cellule fusionnées ne compte que pour une case. quelqu'un
a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je
n'ai

pas pas de cellule fusionnée qui sont sur des lignes différentes)

Bonsoir,

Une bricole qui peut peut-être te dépanner :
Si aucune des cellules (fusionnées ou non) de la zone n'est vide, compter le
nombre de valeurs présentes équivaut à compter le nombre des cellules..

Sub test()
MsgBox Application.CountA(Range("A1:D10"))
End Sub

FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex: A1:D10).
Il faut que le cellule fusionnées ne compte que pour une case. quelqu'un
a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je n'ai
pas pas de cellule fusionnée qui sont sur des lignes différentes)

Désolé mais j'ai des cellules vides : mais ça aurait pu être une bonne
alternative

"Frédéric Sigonneau" <frederic.sigonneau@ouanadou.fr> a écrit dans le
message de news:OOmU4wtYEHA.2908@TK2MSFTNGP10.phx.gbl...

Bonsoir,

Une bricole qui peut peut-être te dépanner :
Si aucune des cellules (fusionnées ou non) de la zone n'est vide, compter
le

nombre de valeurs présentes équivaut à compter le nombre des cellules..

Sub test()
MsgBox Application.CountA(Range("A1:D10"))
End Sub

FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex:
A1:D10).

Il faut que le cellule fusionnées ne compte que pour une case. quelqu'un
a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je
n'ai

pas pas de cellule fusionnée qui sont sur des lignes différentes)

Merci, ça à l'air de marcher

tu es sure qu'il faut mettre Option Base 1 ? ça a l'air de marcher sans

j'utilise plustot cette macro en fonction voila le code si ça t'interesse :
Function CompteNombreCellules(MaSelection As Range) As Integer 'macro très
fortement inspirée d'une macro de Rv

Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
'Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In MaSelection

' Si on est sur une cellule fusionnée
If objCell.MergeCells Then

' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next

' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next

'MsgBox "Résultat : " & lngNbrCell
CompteNombreCellules = lngNbrCell

End Function


"Rv" <herve.pinardPASDESPAM@free.fr> a écrit dans le message de
news:%23MTwJpqYEHA.2972@tk2msftngp13.phx.gbl...

Petite précision importante : le module dans lequel on insère cette
procédure doit commencer par l'instruction
Option Base 1
pour préciser que le premier élément des tableaux est l'indice 1 et non 0
comme par défaut.

A+

Rv

"Rv" <herve.pinardPASDESPAM@free.fr> a écrit dans le message de
news:uOMWtmqYEHA.2840@TK2MSFTNGP11.phx.gbl...

Re,

La même en plus général: les fusions peuvent être quelconques:

Sub compteNombreCellules()
Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In objRange.Cells
' Si on est sur une cellule fusionnée
If objCell.MergeCells Then
' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next
' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next
MsgBox "Résultat : " & lngNbrCell
End Sub

A+

Rv


"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%239QxHopYEHA.2736@TK2MSFTNGP10.phx.gbl...

Bonjours,

je voudrais compter le nombre de cases qu'il y a dans une zone (ex:
A1:D10).

Il faut que le cellule fusionnées ne compte que pour une case.
quelqu'un

a-t-il une solution ?

Remarque : mes cellules fusionnées sont toujour sur la même ligne ( je
n'ai

pas pas de cellule fusionnée qui sont sur des lignes différentes)

Salut Emcy,

Non en effet ce n'est pas si important que ça! Mais c'est quand même un peu
plus "propre".
Ce n'est pas si important car la fonction gère explicitement la borne min du
tableau avec 1 pour minimum dans:

For lngIndTabRange = 1 To lngMaxIndTabRange


For lngIndTabRange = lbound(lngTabRange) To lngMaxIndTabRange

Il pourrait y avoir des soucis...


Et puis il est en effet beaucoup plus naturel d'utiliser cette macro en
fonction!

A+

Rv




"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%23iUfBSzYEHA.1356@TK2MSFTNGP09.phx.gbl...

Merci, ça à l'air de marcher

tu es sure qu'il faut mettre Option Base 1 ? ça a l'air de marcher sans

j'utilise plustot cette macro en fonction voila le code si ça t'interesse
:

Function CompteNombreCellules(MaSelection As Range) As Integer 'macro très
fortement inspirée d'une macro de Rv

Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
'Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In MaSelection

' Si on est sur une cellule fusionnée
If objCell.MergeCells Then

' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next

' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next

'MsgBox "Résultat : " & lngNbrCell
CompteNombreCellules = lngNbrCell

End Function

Bonsoir,

Il y a aussi cela:

'================= Compte Non-Fusionnées Daniel M.
Function CNF(MaSelection As Range) As Long
Dim i As Long, C As Range
i = 0
For Each C In MaSelection
If C.MergeCells Then
If C.Address <> C.MergeArea(1, 1).Address Then
i = i + 1 ' pas la première, on la soustraiera du total
End If
End If
Next C
CNF = MaSelection.Cells.Count - i
End Function
' ================= Fin du code

Comme les autres, elle a le défaut de ne pas être directement reliée au moteur
de calcul/recalcul d'Excel.

Salutations,

Daniel M.

"Rv" <herve.pinardPASDESPAM@free.fr> wrote in message
news:On%23gAZzYEHA.3716@TK2MSFTNGP11.phx.gbl...

Salut Emcy,

Non en effet ce n'est pas si important que ça! Mais c'est quand même un peu
plus "propre".
Ce n'est pas si important car la fonction gère explicitement la borne min du
tableau avec 1 pour minimum dans:

For lngIndTabRange = 1 To lngMaxIndTabRange


For lngIndTabRange = lbound(lngTabRange) To lngMaxIndTabRange

Il pourrait y avoir des soucis...


Et puis il est en effet beaucoup plus naturel d'utiliser cette macro en
fonction!

A+

Rv




"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%23iUfBSzYEHA.1356@TK2MSFTNGP09.phx.gbl...

Merci, ça à l'air de marcher

tu es sure qu'il faut mettre Option Base 1 ? ça a l'air de marcher sans

j'utilise plustot cette macro en fonction voila le code si ça t'interesse
:

Function CompteNombreCellules(MaSelection As Range) As Integer 'macro très
fortement inspirée d'une macro de Rv

Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
'Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In MaSelection

' Si on est sur une cellule fusionnée
If objCell.MergeCells Then

' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next

' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next

'MsgBox "Résultat : " & lngNbrCell
CompteNombreCellules = lngNbrCell

End Function

Bonjour Emcy,

Tu peux copier ceci dans la feuille module où l'action se déroule, et à chaque fois que tu cliqueras dans la plage
A1:D10, tu auras un message t'indiquant le nombre de cellules dans cette zone.

'------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rg As Range
Set Rg = Range("A1:D10")
If Not Intersect(Rg, Target) Is Nothing Then
For Each c In Rg
If c.MergeCells Then
r = r + 1 / c.MergeArea.Cells.Count
Else
r = r + 1
End If
Next
MsgBox Int(r)
End If
Set Rg = Nothing
End Sub
'------------------------


Salutations!






"Daniel.M" <prenom.maher@bigfoot.inutil.com> a écrit dans le message de news:umeYsv8YEHA.2456@TK2MSFTNGP10.phx.gbl...
Bonsoir,

Il y a aussi cela:

'================= Compte Non-Fusionnées Daniel M.
Function CNF(MaSelection As Range) As Long
Dim i As Long, C As Range
i = 0
For Each C In MaSelection
If C.MergeCells Then
If C.Address <> C.MergeArea(1, 1).Address Then
i = i + 1 ' pas la première, on la soustraiera du total
End If
End If
Next C
CNF = MaSelection.Cells.Count - i
End Function
' ================= Fin du code

Comme les autres, elle a le défaut de ne pas être directement reliée au moteur
de calcul/recalcul d'Excel.

Salutations,

Daniel M.

"Rv" <herve.pinardPASDESPAM@free.fr> wrote in message
news:On%23gAZzYEHA.3716@TK2MSFTNGP11.phx.gbl...

Salut Emcy,

Non en effet ce n'est pas si important que ça! Mais c'est quand même un peu
plus "propre".
Ce n'est pas si important car la fonction gère explicitement la borne min du
tableau avec 1 pour minimum dans:

For lngIndTabRange = 1 To lngMaxIndTabRange


For lngIndTabRange = lbound(lngTabRange) To lngMaxIndTabRange

Il pourrait y avoir des soucis...


Et puis il est en effet beaucoup plus naturel d'utiliser cette macro en
fonction!

A+

Rv




"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%23iUfBSzYEHA.1356@TK2MSFTNGP09.phx.gbl...

Merci, ça à l'air de marcher

tu es sure qu'il faut mettre Option Base 1 ? ça a l'air de marcher sans

j'utilise plustot cette macro en fonction voila le code si ça t'interesse
:

Function CompteNombreCellules(MaSelection As Range) As Integer 'macro très
fortement inspirée d'une macro de Rv

Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
'Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In MaSelection

' Si on est sur une cellule fusionnée
If objCell.MergeCells Then

' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next

' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next

'MsgBox "Résultat : " & lngNbrCell
CompteNombreCellules = lngNbrCell

End Function

Bonsoir Emcy,

Tu peux copier ceci dans la feuille module où l'action se déroule, et à chaque fois que tu cliqueras dans la plage
A1:D10, tu auras un message t'indiquant le nombre de cellules dans cette zone.

'-----------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rg As Range, X As Integer, R As Double

Set Rg = Union(Target, Range("A1:D10"))
If Not Intersect(Rg, Target) Is Nothing Then
For Each c In Rg
If c.MergeCells Then
X = Intersect(c.MergeArea, Rg).Cells.Count
r = r + 1 / X
Else
r = r + 1
End If
Next
MsgBox r

End If
Set Rg=Nothing
End Sub
'-----------------------------


Salutations!







"Daniel.M" <prenom.maher@bigfoot.inutil.com> a écrit dans le message de news:umeYsv8YEHA.2456@TK2MSFTNGP10.phx.gbl...
Bonsoir,

Il y a aussi cela:

'================= Compte Non-Fusionnées Daniel M.
Function CNF(MaSelection As Range) As Long
Dim i As Long, C As Range
i = 0
For Each C In MaSelection
If C.MergeCells Then
If C.Address <> C.MergeArea(1, 1).Address Then
i = i + 1 ' pas la première, on la soustraiera du total
End If
End If
Next C
CNF = MaSelection.Cells.Count - i
End Function
' ================= Fin du code

Comme les autres, elle a le défaut de ne pas être directement reliée au moteur
de calcul/recalcul d'Excel.

Salutations,

Daniel M.

"Rv" <herve.pinardPASDESPAM@free.fr> wrote in message
news:On%23gAZzYEHA.3716@TK2MSFTNGP11.phx.gbl...

Salut Emcy,

Non en effet ce n'est pas si important que ça! Mais c'est quand même un peu
plus "propre".
Ce n'est pas si important car la fonction gère explicitement la borne min du
tableau avec 1 pour minimum dans:

For lngIndTabRange = 1 To lngMaxIndTabRange


For lngIndTabRange = lbound(lngTabRange) To lngMaxIndTabRange

Il pourrait y avoir des soucis...


Et puis il est en effet beaucoup plus naturel d'utiliser cette macro en
fonction!

A+

Rv




"Emcy" <ten.etsop@ycme.ycme> a écrit dans le message de
news:%23iUfBSzYEHA.1356@TK2MSFTNGP09.phx.gbl...

Merci, ça à l'air de marcher

tu es sure qu'il faut mettre Option Base 1 ? ça a l'air de marcher sans

j'utilise plustot cette macro en fonction voila le code si ça t'interesse
:

Function CompteNombreCellules(MaSelection As Range) As Integer 'macro très
fortement inspirée d'une macro de Rv

Dim objCell As Range
Dim objRange As Range
Dim lngTabRange() As Range
Dim lngMaxIndTabRange As Long
Dim lngIndTabRange As Long

Dim lngNbrCell As Long
Dim booTrouve As Boolean

' Init
lngMaxIndTabRange = 0
lngNbrCell = 0

' Récup de la sélection
'Set objRange = Application.Selection

' Parcours des cellules de la sélection

For Each objCell In MaSelection

' Si on est sur une cellule fusionnée
If objCell.MergeCells Then

' On recherche dans le tableau des fusions si la zone existe
déjà
booTrouve = False
For lngIndTabRange = 1 To lngMaxIndTabRange
If objCell.MergeArea.Address > > lngTabRange(lngIndTabRange).Address Then
booTrouve = True
Exit For
End If
Next

' Si on ne trouve pas cette zone dans le tableau des zones
fusionnées
If Not booTrouve Then
' On ajoute la zone au tableau
lngMaxIndTabRange = lngMaxIndTabRange + 1
ReDim Preserve lngTabRange(lngMaxIndTabRange)
Set lngTabRange(lngMaxIndTabRange) = objCell.MergeArea
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
' Si on est pas sur une cellule fusionnée
Else
' On augmente de 1 le nombre de cellules
lngNbrCell = lngNbrCell + 1
End If
Next

'MsgBox "Résultat : " & lngNbrCell
CompteNombreCellules = lngNbrCell

End Function