Comportement anormale - Suppression de ligne dans tableau structuré

[taratata]

Bonjour,

j'ai un tableau structuré nommé Nicotine. Le code ci-dessous à pour fonction de supprimer toutes les lignes du tableau dont la valeur est à zéro pour une colonne cible.
Cela fonctionne parfaitement.
Par contre, s'il y a une seul est unique ligne (1er ligne), alors la code la supprime.

 With [Nicotine]
        .Columns(18).EntireColumn.Insert                                                ' colonne auxiliaire
        .Columns(18) = "=1/(RC[-2]=0)"                                                  ' RC[-2] : Nb Colonne(s) avant Colonne Auxiliaire = (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

Que dois ajouter ou modifier dans cette routine, s'il vous plaît,

Merci à tous...

 

[Hasco]

Bonsoir,

A tenter:

 With [Nicotine]
        .Columns(18).EntireColumn.Insert                                                ' colonne auxiliaire
        .Columns(18) = "=1/(RC[-2]=0)"                                                  ' RC[-2] : Nb Colonne(s) avant Colonne Auxiliaire = (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
        with Intersect(.Columns(18).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells)
         if .Rows.Count>1 Then    .Delete xlUp
        end with
        .Columns(18).ClearContents                                                      ' Supprimer data dans les cellules de la colonne
    End With

Bon week-end

Edit: Si c'est réellement un tableau structuré, utiliser sa propriété DataBodyRange pour n'en retourner que les lignes de données.

 

[taratata]

ça fonctionne - pas de suppression
mais s'il y a plusieurs lignes alors pas de suppression aussi

 

[Hasco]

Re bonjour,

Je savais bien qu'il est vain de tenter de voler dans le vide.

Bonne continuation

 

[taratata]

If .Rows.Count > 1 Then
Intersect(.Columns(17).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
End If

comme ceci ok

 

[chris]

Bonjour

Il y a des ambiguïtés

Tu ajoutes une colonne pour tester mais tu ne la supprimes pas à la fin donc au fur et à mesure tu auras pléthore de colonnes...

Tu parles de colonne 18 qui pour Excel est R mais aussi de Q qui ne correspond pas à RC-2 sauf si ton tableau commence en B

Il serait plus prudent de raisonner en ListObject...

A adapter

 With [Nicotine]
    If .ListObject.DataBodyRange.Rows.Count = 1 Then
        If .Cells(1, 16) = 0 Then .ListObject.DataBodyRange.Delete: Exit Sub
    Else
        .Columns(18).EntireColumn.Insert                                         ' colonne auxiliaire
        .Columns(18) = "=1/(RC[-2]=0)"                                           ' RC[-2] : Nb Colonne(s) avant Colonne Auxiliaire = (la colonne cible à traiter) --> "Q"
            .Sort .Columns(18), xlDescending, Header:=xlYes                                 ' tri pour accélérer
                Intersect(.Columns(18).SpecialCells(xlCellTypeFormulas, 1), .Cells).EntireRow.Delete xlUp
        .Columns(18).Delete                                                      ' Supprimer  la colonne
    End If
End With

 

[job75]

Bonjour taratata, Roblochon, chris,

Cela fonctionne parfaitement.

Sûrement pas car à la fin la colonne (18) est effacée au lieu d'être supprimée.

La 1ère ligne n'est jamais supprimée si toutes les colonnes ont des en-têtes.

Enfin il y a bug s'il n'y a pas de valeur zéro ou de vide en 16ème colonne.

Code corrigé :

With [Nicotine]
    .Columns(18).EntireColumn.Insert
    .Columns(18) = "=1/(RC[-2]=0)"
    .Columns(18) = .Columns(18).Value
    .Sort .Columns(18), xlDescending, Header:=xlYes 'tri pour accélérer
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Columns(18).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
    .Columns(18).EntireColumn.Delete                                                      ' Supprimer data dans les cellules de la colonne
End With

A+

 

[taratata]

Tous les Tableaux avec entête commencent en colonne B

Cas de figure - Tableau vierge puis se rempli
-------------------------------------------------
1 - routine ligne à Zéro - Fonctionne bien

    With [Nicotine]
        .Columns(18).EntireColumn.Insert                                                ' colonne auxiliaire
        .Columns(18) = "=1/(RC[-2]=0)"                                                  ' RC[-2] : Nb Colonne(s) avant Colonne Auxiliaire = (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
       
        If .Rows.Count > 1 Then
            Intersect(.Columns(18).SpecialCells(xlCellTypeConstants, 1).EntireRow, .Cells).Delete xlUp
        End If
        .Columns(18).ClearContents                                                      ' Supprimer data dans les cellules de la colonne
    End With

2 - routine ligne vide - Fonctionne bien

With [Nicotine_OUT]
    If .Rows.Count > 1 Then
    Dim Rng1 As Range
    On Error Resume Next
    Set Rng1 = Range("Nicotine_OUT[[ID_CMD]]").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
        If Not Rng1 Is Nothing Then
          Rng1.Delete Shift:=xlUp
        End If
    End If
End With

3 - Transfert d'un tableau (stock) à un autre (stock) lorsque quantité à Zéro - Fonctionne bien

' Condition - 2 étant la nombre de ligne lorsque le tableau est vide (Entête + 1 ligne)
If Last_Ligne_St_NIC > 2 Then

' ----  Tableaux - Nicotine ---
'------------------------------
    For kk = 1 To Last_Ligne_St_NIC
        If List_obj_St_NIC.Range(kk, 16).Value = Valeur Then
           
            'MsgBox "Le tableau :  " & List_obj_St_NIC & Chr(13) & Chr(10) & "à la Ligne  " & kk & Chr(13) & Chr(10) & _
            "à une valeur de :  " & Valeur
   
            ' Nicotine_OUT - Compte le nombre de ligne (entête comprise étant la ligne No. 1)
            Last_Ligne_St_NIC_OUT = (List_obj_St_NIC_OUT.Range.Rows.Count)
            Set List_row_St_NIC_OUT = List_obj_St_NIC_OUT.ListRows.Add
            List_obj_St_NIC_OUT.ListRows.Add                ' Ajout d'un ligne supplémentaire (cas particulier)
            'MsgBox "Le tableau " & List_obj_St_NIC_OUT & Chr(13) & Chr(10) & "contient " & Last_Ligne_St_NIC_OUT & " lignes"
           
            ' Copie la ligne cible du tabeau cible
            List_obj_St_NIC.ListRows.item(kk - 1).Range.EntireRow.Copy
           
            ' Colle la ligne cible du tabeau destination
            List_obj_St_NIC_OUT.ListRows.item(Last_Ligne_St_NIC_OUT - 1).Range.EntireRow.PasteSpecial
           
            Application.CutCopyMode = False
           
        End If
    Next
End If

merci à tous pour vos précieuses aides.

 

[job75]

Indécrottable le gars (ou la garce), sur un autre fil :

Vous avez pris la fâcheuse habitude de poser des questions à tire-larigot sans tenir le moindre compte des solutions qu'on vous donne.

Continuez comme ça taratata, on vous laissera tomber.