Supprimer une ligne d'un tableau nommée

[taratata]

Bonjour,

j'ai tableau nommé BaseNeutre sur lequel j'arrive à supprimer toutes les ligne vides
par contre je cherche à supprimer toutes les lignes ayant dans une colonne (ex: Col16) la valeur 0

j'ai test ceci sans succès

Dim Rng1 As Range
        On Error Resume Next
        Set Rng1 = Range("BaseNeutre[[QtDisp]]").SpecialCells(xlCellTypeAllFormatConditions).Delete
        On Error GoTo 0
            If Not Rng1 Is Nothing Then
              Rng1.Delete Shift:=xlUp
            End If

ou ceci

Application.ScreenUpdating = 0: Application.DisplayAlerts = 0                                                  'à supprimer si pas nécessaire
    Application.Calculation = xlCalculationManual                                                                 'plus rapide si de nombreuses formules
    On Error Resume Next                                                                                          'pas de correspondance
        With [BaseNeutre]
         .AutoFilter Field:=16, Criteria1:="0.00": .SpecialCells(xlCellTypeAllFormatConditions).Delete: .AutoFilter
         .AutoFilter Field:=16, Criteria1:=0#: .SpecialCells(xlCellTypeAllFormatConditions).Delete: .AutoFilter
        End With
        

        Application.Calculation = xlCalculationAutomatic

une idée sîl vous plaît

 

[job75]

Bonjour taratata, bienvenue sur XLD,

Grâce au tri cette macro est très rapide :

Sub SupprimeZeros()
Application.ScreenUpdating = False                                                  'à supprimer si pas nécessaire
Application.Calculation = xlCalculationManual                                                                 'plus rapide si de nombreuses formules
On Error Resume Next                                                                                          'pas de correspondance
With [BaseNeutre]
    .Columns(16).EntireColumn.Insert 'colonne auxiliaire
    .Columns(16) = "=1/(RC[1]=0)"
    .Columns(16) = .Columns(16).Value 'supprime les formules
    .Sort .Columns(16), xlDescending, Header:=xlYes 'tri pour accélérer
    Intersect(.Columns(16).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
    .Columns(16).EntireColumn.Delete
End With
Application.Calculation = xlCalculationAutomatic
End Sub

A+

 

[taratata]

merci
il ya un soucis
toute les lignes dont la colonne à une valeur NON à zéro
à une erreur --> #DIV/0!

je pense que le soucis vient d'ici ...

 

[taratata]

J'ai compris, il faut une colonne auxiliaire pour la parité True/False --> #DIV/0!

comment puis supprimer --> #DIV/0! de la colonne?

 

[taratata]

c'est ok
.Columns(16).ClearContents

Merci mille fois pour votre temps ...

 

[job75]

c'est ok
.Columns(16).ClearContents

Je ne vois pas le rapport...

 

[taratata]

c'est pour supprimer le contenu des cellules après traitement

 

[taratata]

comment passer une variable à la place du nom fixe d'une table dans --> With [BaseNeutre] ?

 

[job75]

c'est pour supprimer le contenu des cellules après traitement

Si j'ai mis ça c'est pas pour des prunes :

    .Columns(16).EntireColumn.Delete

 

[job75]

comment passer une variable à la place du nom fixe d'une table dans --> With [BaseNeutre] ?

De nombreuses solutions sont possibles, par exemple :

With [A1].CurrentRegion

ou bien :

With ActiveSheet.UsedRange

ou encore :

With Application.InputBox("Sélectionnez la plage de cellules à étudier :", Type:=8)
    Application.ScreenUpdating = False

 

[taratata]

merci pour votre aide.

je pense que c'est dû à la feuille contenant 3 tableaux structurés. Je me suis aperçu que je devais obligatoirement avoir le même nombre de colonne.
ceci ne fonctionne pas --> .Columns(16).EntireColumn.Delete
par contre ça - oui --> .Columns(16).ClearContents

 

[job75]

Libre à vous de jouer les cachotiers sans montrer de fichier, alors faites joujou tout seul

 

[taratata]

- en fait je prépare une gestion de stock du DIY e-liquide (VP PG Nicotine & Arôme). ces du pure DIY. Puis un suivis de la vape avec quelques stats... Une fois fini, le fichier sera e ligne gratuitement sur ma chaine youtube.

voici le code

Sub Suppression_Ligne_Zero_BN_NIC()
            
    Application.ScreenUpdating = False                                                  ' à supprimer si pas nécessaire
    Application.Calculation = xlCalculationManual                                       ' plus rapide si de nombreuses formules
    On Error Resume Next                                                                ' pas de correspondance
    
    With [BaseNeutre]
        .Columns(17).EntireColumn.Insert                                                ' colonne auxiliaire
        .Columns(17) = "=1/(RC[-1]=0)"                                                  ' RC[-1] : 1 Colonne avant (la colonne cible à traiter) --> "Q"
                                                                                        ' Valeur de retour --> True - False
        .Columns(17) = .Columns(17).Value                                               ' supprime les formules
        .Sort .Columns(17), xlDescending, Header:=xlYes                                 ' tri pour accélérer
        Intersect(.Columns(17).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
        .Columns(17).ClearContents                                                      ' Supprimer data dans les cellules de la colonne
    End With
        
    With [Nicotine]
        .Columns(18).EntireColumn.Insert                                                ' colonne auxiliaire
        .Columns(18) = "=1/(RC[-2]=0)"                                                  ' RC[-1] : 1 Colonne avant (la colonne cible à traiter) --> "Q"
                                                                                        ' Valeur de retour --> True - False
        .Columns(18) = .Columns(18).Value                                               ' supprime les formules
        .Sort .Columns(18), xlDescending, Header:=xlYes                                 ' tri pour accélérer
        Intersect(.Columns(18).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
        .Columns(18).ClearContents                                                      ' Supprimer data dans les cellules de la colonne
    End With
    Application.Calculation = xlCalculationAutomatic

End Sub

je suis pour le partage de compétence, d'échange.

 

[job75]

je suis pour le partage de compétence, d'échange.

L'enfer est pavé de bonnes intentions.