IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

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


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Octobre 2015
    Messages : 3
    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  2. #2
    Membre Expert Avatar de antonysansh
    Homme Profil pro
    Chargé d'études RH
    Inscrit en
    Mai 2014
    Messages
    1 115
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 33
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Chargé d'études RH
    Secteur : Finance

    Informations forums :
    Inscription : Mai 2014
    Messages : 1 115
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim i As Long, NbLigne As Long
    ou même
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  3. #3
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Octobre 2015
    Messages : 3
    Par défaut
    Ca fonctionne

    Merci !

  4. #4
    Expert éminent


    Profil pro
    Inscrit en
    Juin 2003
    Messages
    14 008
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2003
    Messages : 14 008
    Par défaut
    Citation Envoyé par Sebbt Voir le message
    Ca fonctionne

    Merci !
    utilise le bouton sous ce message pour le signaler..

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Formulaire VBA problème avec cellules contenant des dates
    Par Sudeki dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 10/10/2013, 12h54
  2. Probléme avec la suppression de ligne dans un tableau
    Par Tintou dans le forum VBA Word
    Réponses: 6
    Dernier message: 20/08/2009, 15h06
  3. POI rencontre un problème avec la suppression des onglets
    Par hicham_alaoui1 dans le forum Documents
    Réponses: 0
    Dernier message: 12/10/2008, 20h54
  4. problème avec la suppression des doublons dans arraylsit
    Par ulysse031 dans le forum Langage
    Réponses: 13
    Dernier message: 04/03/2007, 12h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo