somme avec des cellules fusionnées

pascal21

XLDnaute Barbatruc
bonjour le forum
j'ai en colonne 2 des cellules fusionnées de taille variable
ex b1:b14 b15:b22 etc...
j'aimerais en se basant sur cet exemple additionner les cellules de la colonne A
correspondantes à la taille des cellules fusionnées
je pense qu'il y a du index equiv la dedans mais je ne maitrise pas cette formule
merci de votre aide
 

Pièces jointes

  • cellules fusionnées.xlsx
    9.8 KB · Affichages: 54

Robert

XLDnaute Barbatruc
Bonjour Pascal, bonjour le forum,

Si un solution VBA t'intéresse, voici une proposition :
VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
Set PL = O.Range("B1:B" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    If CEL.MergeCells = True Then 'condition : si la cellule est fusionnée
        'définit la valeur de la cellule
        CEL.Value = Application.WorksheetFunction.Sum(CEL.Offset(0, -1).Resize(CEL.MergeArea.Cells.Count))
    Else 'sinon
        CEL.Value = CEL.Offset(0, -1).Value 'définit la valeur de la cellule
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
End Sub
 

pascal21

XLDnaute Barbatruc
bonjour et merci à vous deux pour vos reponses
JHA
ta solution à l'avantage de ne pas comporter de macro grace à une astuce
Code:
=NbCells(B1)
mais elle m'oblige quand à recopier manuellement dans les cellules fusionnées le resultat
Robert
çà fonctionne parfaitement
mais je butte sur une petite modification que je voudrai apporter concernant le nombre de lignes
car actuellement dans l'etat ton code, si j'ai bien compris analyse toute la feuille
ce qui fait que le traitement prends env. 30 secondes
je me disais que en nommant une plage moins grande çà prendrait moins de temps
Code:
Set PL = O.Range("w1:w1481" & DL) 'définit la plage PL
en mettant ça j'ai une erreur
ça doit etre lié à la ligne du dessus qui elle analyse jusqu'au bas non?
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,

DL n'est pas une plage mais l'index de la dernière ligne comme Robert l'indique dans ses commentaires

VB:
Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, "W").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne W de l'onglet O
Set PL = O.Range("W1:W" & DL) 'définit la plage PL
A+ à tous
 

ROGER2327

XLDnaute Barbatruc
Bonjour à tous.

Ceci, sur le même principe que celui de Robert, devrait être beaucoup plus rapide. (À vérifier...)
VB:
Sub aaa()
Dim i&, j&, p As Range, q As Range, v(), x#
  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
  Set p = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).Cells
  j = 1
  Do While j <= p.Rows.Count
    Set q = p.Cells(j, 1).Cells
    If q.MergeCells = True Then
      v = q.Offset(0, -1).Resize(q.MergeArea.Count, 1).Value
      x = 0: For i = 1 To UBound(v): x = x + v(i, 1): Next
      j = j + UBound(v)
    Else
      x = q.Offset(0, -1).Value
      j = j + 1
    End If
    q.Value = x
  Loop
  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub

ℝOGER2327
#8523


Mardi 10 Clinamen 144 (Rémission des Poissons - fête Suprême Quarte)
12 Germinal An CCXXV, 6,9257h - charme
2017-W13-6T16:37:18Z
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,

Sur 10 000 lignes :

upload_2017-4-1_19-20-24.png


A+ à tous
 

ROGER2327

XLDnaute Barbatruc
Suite...

Merci JCGL !

Meilleur :
VB:
Sub bbb()
Dim i&, j&, p As Range, q As Range, v(), w(), x#
  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
  Set p = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).Cells
  w = p.Value
  j = 1
  Do While j <= UBound(w)
    Set q = p.Cells(j, 1).Cells
    If q.MergeCells = True Then
      v = q.Offset(0, -1).Resize(q.MergeArea.Count, 1).Value
      x = 0: For i = 1 To UBound(v): x = x + v(i, 1): Next
      w(j, 1) = x
      j = j + UBound(v)
    Else
      w(j, 1) = q.Offset(0, -1).Value
      j = j + 1
    End If
  Loop
  p.Value = w
  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub
ℝOGER2327
#8524


Mardi 10 Clinamen 144 (Rémission des Poissons - fête Suprême Quarte)
12 Germinal An CCXXV, 9,6434h - charme
2017-W13-6T23:08:39Z
 

pascal21

XLDnaute Barbatruc
bonjour merci à tous
après avoir bien galèré pour adapter sur mon classeur (ca m'apprendra à mettre un fichier qui corresponde la prochaine fois) encore que comme çà je cherche à comprendre et j'apprends
car au final
la colonne A c'est dans mon fichier la colonne T
la colonne B c'est dans mon fichier la colonne W
donc çà marche pour les colonnes T et W
est-ce que pour faire la même chose pour les colonnes U et X, V et Y, il faut réecrire deux fois le code en changeant le nom des variables ou deux lignes "magiques" sont suffisantes?
merci bon dimanche
 

Discussions similaires

Réponses
5
Affichages
148

Statistiques des forums

Discussions
299 850
Messages
1 979 570
Membres
206 780
dernier inscrit
Edwige81