Microsoft 365 Macro modification que je ne sais pas faire

Usine à gaz · 5 Juin 2022

Bonjour à toutes et à tous,
Je vous souhaite une beau dimanche

Voici ci-dessous un code que j'ai besoin de modifier mais je n'y arrive pas malgré mes tentatives et recherches.
Pourriez-vous m'aider ?

VB:

Sub Lgn_vides()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect Password:=""
    Sheets("RdV_faits").Select
        ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
        'Rows("107:10015").Select '???
        Selection.Delete Shift:=xlUp
        'Columns("R:ZZ").Select '???' R à dernière col vide
        Selection.Delete Shift:=xlToLeft
    Range("A1").Select
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

L'objectif est de supprimer les lignes et colonnes vides
Codes que je cherche à modifier :
Supprime toutes les lignes à partir de la 1ère cellule A (cellule active) vide
1er..... Code que je cherche à modifier : "'Rows("107:10015").Select '???" par de la 1ère ligne active à la dernière ligne vide,
Supprime toutes les colonnes à partir de la col "R" jusqu'à la dernière colonne vide
2eme Code que je cherche à modifier : "'Columns("R:ZZ").Select '???' R à dernière col vide

Si vous voulez bien juste modifier mes codes ci-dessus, ça, je pourrai le comprendre
Si besoin, je ferai un fichier test.
Un grand Merci ... je continue mes recherches,
Amicalement,
lionel

sylvanu · 6 Juin 2022

VB:

DL = 1 + Range("A1048576").End(xlUp).Row

C'est ce que ça veut dire.
Si par exemple la dernière cellule occupée est A17 alors DL vaut 18.

TooFatBoy · 6 Juin 2022

Marcel32 à dit:
Tu as beaucoup de colonnes après ZZ ?

Usine à gaz à dit:
"As-tu essayé de réduire la plage de CountA ?"
NON mais je ne sais pas le faire Grrrr !!!

Ben au lieu de Rows(r) essaye un Range pour limiter le nombre de colonnes.

Usine à gaz · 6 Juin 2022

"Tu as beaucoup de colonnes après ZZ ?"
C'est pas les colonnes le souci : la suppression des colonnes est instantanée.
Le souci, c'est les lignes et c'est bien ce code de suppression de lignes qui est TRES TRES TRES long :

VB:

derniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = derniereLigne To 2 Step -1 ou     For r = derniereLigne To 6 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r

TooFatBoy · 6 Juin 2022

Une petite dernière tentative...

Marcel32 à dit:
Tu as beaucoup de colonnes après ZZ ?

Usine à gaz · 6 Juin 2022

"Tu as beaucoup de colonnes après ZZ ?"
Merci Marcel pour tes tentatives mais je ne comprends pas pourquoi tu me poses cette question car même si je n'ai pas de colonne à supprimer, j'ai toujours le souci du code suppression des lignes qui est toujours TRES TRES TRES long.

TooFatBoy · 6 Juin 2022

Pas grave.

Bonne chance dans ta recherche de solution.

Usine à gaz · 6 Juin 2022

Pas compris mais merci quand même

sylvanu · 6 Juin 2022

Bonjour tout le monde,
Alors un essai d'après ce que j'ai compris de toutes ces errances :

VB:

Sub SuppressionLignesVides()
    Application.ScreenUpdating = False
    DerniereLigne = Range("A65000").End(xlUp).Row
    ' On repère la première ligne vide
    For L1 = 1 To DerniereLigne
        If Cells(L1, "A") = "" Then
            PremièreLigneVide = L1
            Exit For
        End If
    Next L1
    ' On repère la dernière ligne vide
    For L2 = L1 To DerniereLigne
        If Cells(L2, "A") <> "" Then
            DernièreLigneVide = L2 - 1
            Exit For
        End If
    Next L2
    ' On supprime
    Rows(PremièreLigneVide & ":" & DernièreLigneVide).Delete Shift:=xlUp
End Sub

Il n'y a qu'une suppression de lignes.

Si c'est pas ça, faites une petite image comme ci dessus, ça aidera.

TooFatBoy · 6 Juin 2022

sylvanu à dit:
Alors un essai d'après ce que j'ai compris de toutes ces errances

D'après ce que j'ai compris, il y a des lignes vides n'importe où dans le tableau, donc pas forcément consécutives, et il faut toutes les supprimer.

sylvanu · 6 Juin 2022

Oh! On va finir par converger !

sylvanu · 6 Juin 2022

Tentative de convergence N°2 :

Code:

Sub SupLig()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    ' On créé une colonne en premiere colonne
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' Dans cette colonne on met 1 si la ligne est vide
    For Ligne = DL To 2 Step -1
        If Cells(Ligne, "B") = "" Then Cells(Ligne, "A") = 1
    Next Ligne
    ' On tri cette colonne en valeurs décroissantes, donc les lignes vides au début
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & DL) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil5").Sort
        .SetRange Range("A1:B" & DL)
        .Header = xlYes
        .Apply
    End With
    ' On repère le dernier 1 de la colonne A
    DL = Range("A65500").End(xlUp).Row
    ' On supprime les lignes
    Rows("2:" & DL).Delete Shift:=xlUp
    ' On supprime la colonne A créée précédemment
    Columns("A:A").Delete Shift:=xlToLeft
    [A1].Select
End Sub

Usine à gaz · 6 Juin 2022

Bonjour courageux sylvanu

Waooooh : c'est presque nickel
Juste il faudrait que la suppression commence après :
ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
C'est à dire après la dernière ligne NON VIDE de la feuille.
C'est presque tout bon !
C'est la solution du #post 37 avec une petite modif qui serait le mieux
Bravo

TooFatBoy · 6 Juin 2022

@sylvanu : pardon, mais est-ce que ça ne risque pas de supprimer des lignes dont la première colonne est vide, mais qui ne sont pas totalement vides (par exemple deuxième colonne non vide) ?

Usine à gaz · 6 Juin 2022

Marcel32 à dit:
@sylvanu : pardon, mais est-ce que ça ne risque pas de supprimer des lignes dont la première colonne est vide, mais qui ne sont pas totalement vides (par exemple deuxième colonne non vide) ?

Bonne remarque lol Hé si
voire mon #post 41

TooFatBoy · 6 Juin 2022

Usine à gaz à dit:
Bonne remarque lol Hé si
voire mon #post 41

OK, mais ça n'a rien à voir avec ce que tu dis en #41.

sylvanu · 6 Juin 2022

Alors un mix avec ma méthode de suppression ( 1 seule suppression ) et le repère de lignes de votre code :

VB:

Sub SupLig()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    ' On créé une colonne en premiere colonne
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' Dans cette colonne on met 1 si la ligne est vide ( reprise code Lionel )
    derniereLigne = ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = derniereLigne To 2 Step -1
        If Application.CountA(Rows(r)) = 0 Then
            Cells(r, "A") = 1
        End If
    Next r
    ' On tri cette colonne en valeurs décroissantes, donc les lignes vides au début
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & DL) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil5").Sort
        .SetRange Range("A1:B" & DL)
        .Header = xlYes
        .Apply
    End With
    ' On repère le dernier 1 de la colonne A
    DL = Range("A65500").End(xlUp).Row
    ' On supprime les lignes
    Rows("2:" & DL).Delete Shift:=xlUp
    ' On supprime la colonne A créée précédemment
    Columns("A:A").Delete Shift:=xlToLeft
    [A1].Select
End Sub

Microsoft 365 Macro modification que je ne sais pas faire

Usine à gaz

XLDnaute Barbatruc

sylvanu

TooFatBoy

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Discussions similaires