XL 2019 Additionner la hauteur d'un nombre de lignes

Cédric06400

XLDnaute Nouveau
Bonjour,

Je cherche à connaitre le résultat dans une cellule de l'addition de plusieurs hauteurs de lignes

Ou pour le dire autrement la hauteur totale d'une sélection de lignes

Merci de votre aide

Cédric
 

cathodique

XLDnaute Barbatruc
Bonjour,

Si j'ai compris ta demande, à tester
VB:
Option Explicit

Sub Hauteur_Plage()
   Dim myRange As Range, cell As Range, H As Double
   On Error Resume Next
   Set myRange = Application.InputBox(prompt:="Selectionner la plage", Type:=8)
   On Error GoTo 0
   If myRange Is Nothing Then
      Exit Sub
   Else
      For Each cell In myRange
         H = H + cell.EntireRow.RowHeight
      Next
   End If

   MsgBox "La hauteur totale des cellules sélectionnées est: " & H
End Sub
 

job75

XLDnaute Barbatruc
Bonjour Cédric06400, cathodique,
VB:
Sub HauteurTotale()
Dim t#, r As Range, h#
t = Timer
ActiveCell.Activate 'si un objet est sélectionné
Selection.EntireRow.Select
For Each r In Selection.Rows
    h = h + r.RowHeight
Next
MsgBox "Plage " & Selection.Address(0, 0) & vbLf & vbLf & "Hauteur totale " & h & vbLf & vbLf & "Durée du calcul " & Format(Timer - t, "0.00 \sec")
End Sub
Pour tester sélectionnez toute la colonne A...

A+
 

p56

XLDnaute Occasionnel
Bonjour à tous,
On peut aussi aller au plus simple, dans le code le feuille :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox Me.Rows(Target.Rows.Count + Target.Row).Top - Me.Rows(Target.Row).Top
End Sub
P.
 

patricktoulon

XLDnaute Barbatruc
bonjour
@job75 on peut reduire la boucle en bouclant sur les areas
VB:
Sub HauteurTotale()
Dim t#, r As Range, h#
t = Timer
ActiveCell.Activate 'si un objet est sélectionné
Selection.EntireRow.Select
For Each area In Selection.Areas
    h = h + area.Height
Next
MsgBox "Plage " & Selection.Address(0, 0) & vbLf & vbLf & "Hauteur totale " & h & vbLf & vbLf & "Durée du calcul " & Format(Timer - t, "0.00 \sec")
End Sub
 

patricktoulon

XLDnaute Barbatruc
je corrige
si les cellules sélectionnées sont sur plusieurs colonnes
sans modifier la sélection
VB:
Sub HauteurTotale()
Dim t#, r As Range, h#
t = Timer
ActiveCell.Activate 'si un objet est sélectionné
For Each area In Selection.EntireRow.Areas
    h = h + area.Height
Next
MsgBox "Plage " & Selection.Address(0, 0) & vbLf & vbLf & "Hauteur totale " & h & vbLf & vbLf & "Durée du calcul " & Format(Timer - t, "0.00 \sec")
End Sub
 

patricktoulon

XLDnaute Barbatruc
re

@job75 ta version sur 5000 ligne reparties sur 10000
1674902577438.png


ma version avec areas
1674902638009.png
 

patricktoulon

XLDnaute Barbatruc
re
oui rowheight pareil que height
par contre non les résultats en terme de temps n sont pas identiques
comme je l'ai montré sur 5000 lignes réparties sur 10000 chez toi 0.17 chez moi 0.10
je suppose oui que sur moins de ligne la différence est insignifiante
 

Cédric06400

XLDnaute Nouveau
Je viens de me rendre compte que je n'ai pas clôturer cette discussion

Grace à vous tous j'ai réussi à codé exactement ce que j'avais besoin.

Du coup merci à tous

Sub HauteurTotale()
'Calcul la hauteur de la plage définie par le nombre d'arrétés Z321 et renvoie le résultat en AB322
Rows("323:398").EntireRow.AutoFit
Dim t, r As Range, h#
Dim maPlage As Range
t = Range("z321").Value
Set maPlage = Range("A323:A" & t)
For Each area In maPlage.Areas
h = h + area.Height
Next
Range("AB322").Value = h
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 315
Messages
2 087 170
Membres
103 490
dernier inscrit
zatougraf