[XL-2007] Compter les cellules [Résolu]

[manu900]

Bonjour à tous,

J'ai encore quelque difficulté avec le VBA et voilà pourquoi je vous sollicité.

J'aimerai insérer une ligne ,dans un tableau, au milieu de la colonne "A" mais certaines cellules sont fusionnées. Il faut également savoir que j'aurai plusieurs feuilles excel avec des cellules fusionnées et c'est pour cela que j'aimerai créer une macro.


J'ai alors trouvé un autre moyen : en comptant les cellules non vide avec la fonction Application.WorksheetFunction.CountA.
Mais voilà la ligne n'est pas créer au bon endroit car il ne prend pas en compte le nombre de cellule mais le numéro de ligne.

Vous trouverez ci-dessous le code ainsi que mon fichier:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub compter()
 
ws = Worksheet
 
With ws
 
X = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))
Mil = Int(X / 2)
Cells(Mil).Activate
ActiveCell(Mil).Offset(1).Resize(1, 1).EntireRow.Insert
ActiveCell(Mil).Value = "milieu"
End With
End Sub

Sur le fichier, il y a une cellule en rouge et c'est à partir de la que je souhaite insérer une ligne.

Merci pour vos réponses
vba comptage.xlsx

[Qwazerty]

Salut

Voila une solution, je n'ai pas trouvé plus simple

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Option Explicit
 
Sub compter()
'Déclaration des variables
Dim Ws As Worksheet
Dim X As Long, Mil As Long, i  As Integer
Dim TheCell As Range
 
'Initialisation des variables
'Si on manipule un objet (worksheet par exemple) il faut utiliser Set
Set Ws = ThisWorkbook.Sheets("Feuil1")
 
'Pour que With ... est une utilité, il faut ensuite placer des . devant les objet devant être complèter par l'objet spécifié par With (regarde l'aide)
With Ws
    'Je retrancherais 1 pour tenir compte de l'entête de colonne
    X = Application.WorksheetFunction.CountA(.Range("A1", .Cells(.Rows.Count, "A").End(xlUp))) - 1
    Mil = Int(X / 2)
 
    'On pointe la cellule en haut de la colonne
    Set TheCell = .Range("A1")
 
    'On boucle sur les valeurs de 2 à Mil et on tient compte du nombre de cellules fusionnées
    For i = 2 To Mil
        'On regarde si la cellule fait partie d'un groupe de cellules
        Set TheCell = TheCell.Offset(TheCell.Offset(1).MergeArea.Count)
    Next
 
    'On ajoute une ligne a la suite
    TheCell.Offset(1).Insert
    'On ajoute le contenu
    TheCell.Offset(1).Value = "Milieu"
 
End With
 
End Sub

++
Qwaz

[manu900]

Bien joué, Bravo, Bravo

J'ai juste changé :

Code :

TheCell = .Range("A2")

Pour que la ligne insérer se positionne en dessous de "mure" pour avoir le même nombre au dessus et en dessous de la ligne "Milieu".

Merci encore.