[XL-2007] VBA | Problème avec la suppression des lignes

VBA | Problème avec la suppression des lignes

Bonjour à tous,

Je fais mes débuts sur VBA et voici les premiers codes que j'ai réalisé en m'aidant de diverses sources sur internet :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Sub MiseEnForme()
 
ActiveSheet.Unprotect ("mdp")
 
    Dim i, NbLigne As Double
 
    NbLigne = Cells.SpecialCells(xlCellTypeLastCell).Row
    Columns("A:D").AutoFit
 
 
    If NbLigne = 9 Then
        MsgBox "Pas de valeurs"
 
    Else
 
   'Choix de la police, de la taille et de la couleur (majoritaire)
    With Range(Cells(3, 1), Cells(NbLigne, 4))
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Font.Color = RGB(51, 51, 153)
    End With
 
'Mets les 2 dernières colonnes au format comptabilité
    Range(Cells(3, 3), Cells(NbLigne, 4)).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
 
    For i = 2 To NbLigne - 1 '2 lignes en entete
 
'Certaines cellules sont non vides puis vides => Fusion des cellules non vide et vide + mise en forme
     If IsEmpty(Cells(i + 1, 1)) Then
        With Range(Cells(i, 1), Cells(i + 1, 1))
            .Merge
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(31, 73, 125)
            .Font.Bold = True
        End With
'Mise en forme des cellules non vide qui ne sont pas suivies de celulles vides
        ElseIf Not IsEmpty(Cells(i + 1, 1)) Then
         With Cells(i + 1, 1)
            .HorizontalAlignment = xlCenter
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(31, 73, 125)
            .Font.Bold = True
         End With
     End If
 
    If Cells(i + 1, 1).Value Like "Total *" Then
'Dans la première colonne (colonneA), les cellules contenant Total sont fusionnées avec celles
'de la colonne B de la même ligne
        With Range(Cells(i + 1, 1), Cells(i + 1, 2))
            .Merge
            .HorizontalAlignment = xlRight
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(51, 51, 153)
            .Font.Bold = True
        End With
'Sur ces mêmes lignes, mise en forme des 2 dernières colonnes
        With Range(Cells(i + 1, 3), Cells(i + 1, 4))
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(51, 51, 153)
            .Font.Bold = True
        End With
 
    End If
 
    If IsEmpty(Cells(i + 1, 3)) Then
        Cells(i + 1, 3) = 0
    End If
 
    If IsEmpty(Cells(i + 1, 4)) Then
        Cells(i + 1, 4) = 0
    End If
 
    Next
End If
 
ActiveSheet.Protect ("mdp")
 
End Sub

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
36
37
38
39
40
41
42
43
44
45
46
Sub SumTotal()
 
ActiveSheet.Unprotect ("mdp")
 
    Dim i, NbLigne As Double
    Dim SumTotal1, SumTotal2 As Double
 
    NbLigne = Cells.SpecialCells(xlCellTypeLastCell).Row
 
    For i = 2 To NbLigne - 1
 
        If Cells(i + 1, 1).Value Like "Total *" Then
            SumTotal1 = SumTotal1 + Cells(i + 1, 3)
            SumTotal2 = SumTotal2 + Cells(i + 1, 4)
        End If
 
    Next
 
    Cells(NbLigne + 1, 1) = "Total général"
 
    With Range(Cells(NbLigne + 1, 1), Cells(NbLigne + 1, 2))
            .Merge
            .HorizontalAlignment = xlRight
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(51, 51, 153)
            .Font.Bold = True
    End With
 
    Cells(NbLigne + 1, 3) = SumTotal1
    Cells(NbLigne + 1, 4) = SumTotal2
 
    With Range(Cells(NbLigne + 1, 3), Cells(NbLigne + 1, 4))
            .Interior.Color = RGB(219, 229, 241)
            .Borders.Value = 1
            .Borders.Color = RGB(255, 255, 255)
            .Font.Color = RGB(51, 51, 153)
            .Font.Bold = True
    End With
 
    Range(Cells(NbLigne + 1, 3), Cells(NbLigne + 1, 4)).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
 
ActiveSheet.Protect ("mdp")
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Effacer()
 
ActiveSheet.Unprotect ("mdp")
 
    Range(Cells(3, 1), Cells(50000, 4)).Delete Shift:=xlUp
 
    Columns("A:D").AutoFit
 
ActiveSheet.Protect ("mdp")
 
End Sub

Le premier sert à mettre en forme ma sélection : Sur la feuille contenant le code, je viens coller des valeurs sur un nombre de colonnes fixes (4) mais sur un nombre de ligne variable. Dans la première colonne certaines cellules contenant des valeurs sont suivies de cellules vides et le but c'est de fusionner ces cellules vides avec la cellule non vide. (On ne touche pas les 2 premières lignes)
Ex: A3 = A
A4 = VIDE
A5 = VIDE
A6 = B
=> On fusionne A3 A4 et A5
Et il faut faire ça jusqu'a la dernière ligne.

Le deuxième sert à faire la somme des totaux présents dans les 2 dernières colonnes.

Et le troisième sert à effacer les valeurs si on veut recommencer avec de nouvelles données. Et mon problème se situe au niveau de ce code je pense. J'ai l'impression qu'il ne me supprime pas vraiment les cellules.
Je m'explique, je viens coller la plage de données que je veux mettre en forme, celle-ci contient par exemple 150 lignes. Une fois mise en forme, je copie ces valeurs puis j'efface cette plage avec le code effacer. Mais ces 150 lignes, mêmes vides, sont encores prises en compte lorsque je calcule le nombre de ligne avec :

Code:

NbLigne = Cells.SpecialCells(xlCellTypeLastCell).Row

Y a-t-il un moyen de supprimer définitevement ces 150 lignes pour qu'elles ne soient plus prises en comptes ?

Si vous avez des suggestions pour optimiser ces programmes ou des conseils de façon générale je suis preneur !

Merci d'avance

Bonjour Sebbt,

En fait SpecialCells(xlCellTypeLastCell) est la cellule la plus en bas et la plus à droite de toutes les cellules déjà utilisées dans la feuille.
Pour t'en rendre compte, Ctrl + Fin te sélectionne cette cellule.

Pour corriger, tu peux utiliser NbLigne = ActiveSheet.Cells(Application.Rows.Count, 1).End(xlUp).Row cette méthode ignore le fais qu'une ligne est déjà pu être utilisée.

Je me permets aussi une petite remarque :
Tu utilises Dim i, NbLigne As Double en voulant certainement mettre tes variables i et NbLigne de type Double. Mais là, seule NbLigne est de type Double et i est de type Variant.
Pour NbLigne un Long suffit (4 Octets contre 8 pour Double)
Tu peux réécrire comme ça :

Code:

Dim i As Long, NbLigne As Long

ou même

Code:

Dim i&, NbLigne& (& c'est pour As Long)

EDIT :
NbLigne = ActiveSheet.Cells(Application.Rows.Count, 1).End(xlUp).Row est la dernière cellule non vide de la colonne 1
Il faut adapter a la colonne la plus judicieuse dans ton code.

Ca fonctionne

Merci ! :)

Citation:

Envoyé par Sebbt

Ca fonctionne

Merci ! :)

utilise le bouton :resolu: sous ce message pour le signaler..