Supprimer ligne en fonction de la référence et du statut

Le 19/04/2021 à 10:16

Bonjour à tous,

Débutante en VBA, je voudrais créer une macro qui me permette de trier le tableau du deuxième onglet "Extraction Stock

11stocks.zip (596.86 Ko)

" en fonction des références listées dans le premier onglet "Refs".

Plus précisément, pour les références listées dans l'onglet "Refs", je souhaite garder toutes les lignes du tableau "Extraction Stock " tandis que pour les références qui ne sont pas listées dans l'onglet "Refs" je ne souhaite garder que les lignes dont la situation est "STK" et supprimer les lignes dont la situation est "ABE" ou "AVI".

J'ai tenté une macro que vous pourrez voir dans le fichier mais elle ne me donne pas du tout ce que je voudrais... Vous remerciant par avance pour votre aide!

Le 19/04/2021 à 10:36

Bonjour,

Un test avec l'insertion d'une formule et suppression des lignes visibles. J'ai désactivé les calculs, alertes et mise à jour à l'écran afin de ne pas "trop" ralentir le programme :

Sub TRI()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
    .[G2].Formula = "=IF(COUNTIF(REF,D2),"""",IF(F2=""STK"","""",""SUPPR""))"
    .ListObjects(1).Range.AutoFilter Field:=7, Criteria1:="SUPPR"
    .ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    .ShowAllData
    .Columns(7).Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Cdlt,

Le 19/04/2021 à 10:42

Merci mais en lançant la macro j'ai une erreur "Impossible de lire la propriété SpecialCells de la classe Range sur la ligne suivante :

        .ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Le 19/04/2021 à 10:57

Bonjour,

C'est de ma faute il n'y avait pas de cellule visible comme j'ai désactivé le calcul et la mise à jour ... Pas bien réveillé ce matin.

Avec ce code ça fonctionne mieux normalement (par contre un peu long à l’exécution, il faut compter une 20aine de secondes) :

Sub TRI()
Application.Calculation = xlCalculationManual
With ActiveSheet
    .[G2].Formula = "=IF(COUNTIF(REF,D2),"""",IF(F2=""STK"","""",""SUPPR""))"
    .ListObjects(1).Range.AutoFilter Field:=7, Criteria1:="SUPPR"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    .ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    .ShowAllData
    .Columns(7).Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Cdlt,

Le 19/04/2021 à 10:58

Bonjour cmadel, Ergotamine, le forum,

Un autre essai....CTRL + E pour exécuter la macro 'test'.....

9stocks.zip (492.20 Ko)

Cordialement,

Le 19/04/2021 à 11:00

Merci beaucoup, je vais essayer.

De mon côté j'en tenté ceci :

    Dim Tableau() As String
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim I As Long, J As Long, refExists As Boolean

    Set ws1 = Sheets("Refs")
    Set ws2 = Sheets("Extraction Stock OAE")

    nL1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    ReDim Tableau(nL1 - 1)

    For I = 2 To nL
        Tableau(I - 1) = ws1.Cells(I, 1)
        MsgBox (Tableau(I - 1))
    Next I

    nL2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

    For I = nL2 To 2 Step -1
        If Tableau(J) <> ws2.Cells(I, 4) And ws2.Cells(I, 4) <> "STK" Then
            Rows(I & ":" & I).Select
            Selection.Delete Shift:=xlUp
        End If
    Next I

Mais ceci me supprimer toutes les lignes de mon tableau et je ne comprend pas pourquoi.

Le 19/04/2021 à 11:08

Ergotamine, j'ai toujours une erreur "erreur définie par l'application ou par l'objet" sur la ligne suivante :

ListObjects(1).Range.AutoFilter Field:=7, Criterial :="SUPPR"
Le 19/04/2021 à 11:17

Bonjour,

En effet je suis passé par une table structurée pour les références nommée REF j'avais oublié de le préciser.

Voir mon fichier joint.

Cdlt,

13stocks-v3.zip (603.54 Ko)
Le 19/04/2021 à 11:20

Donc vous avez juste transformé la liste des références en tableau nommé REF c'est ça?

Le 19/04/2021 à 11:25

Salut Ergotamine,

En testant ton code, je rencontre la même erreur:

capture

Sauf erreur de ma part, il semblerait que le résultat de la formule soit "" pour toutes les lignes....

Cordialement,

Le 19/04/2021 à 11:26

Xorsankukai, pourriez vous m'expliquer votre macro s'il vous plaît? Par exemple si les références et les situations ne sont pas dans les mêmes colonnes, que dois-je changer? :/

Le 19/04/2021 à 11:29

Bonjour,

Dans l'exemple joint oui. C'est ce qui est utilisé dans la ligne 4 :

Sub TRI()
With ActiveSheet
    .[G2].Formula = "=IF(COUNTIF(REF,D2)>0,"""",IF(F2=""STK"","""",""SUPPR""))"
    .ListObjects(1).Range.AutoFilter Field:=7, Criteria1:="SUPPR"
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    .ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    .ShowAllData
    .Columns(7).Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Ca permet de la rendre dynamique quelque soit le nombre de références renseignées.
Je compte le nombre de fois qu'apparaît D2 dans la liste référence, s'il apparaît au moins une fois >0 (j'avais oublié ce bout là merci de le rajouter) alors je ne met rien car je veux conserver la référence. Si c'est égal à 0 donc pas dans les ref à conserver, je regarde si son statut est STK, si oui alors je n'inscrit rien. Dans tous les autres cas j'inscris SUPPR.
Je filtre la table sur les SUPPR et supprime toutes les lignes visibles, puis je reset la table.

Cdlt,

dit @xorsankukai : En effet j'ai encore foutu le calcul manuel en début de code ... Avec celui posté ci-dessus j'ai un résultat de 2753 lignes sans erreur ..

Le 19/04/2021 à 11:43

Merci Ergotamine, mais même en ayant modifié comme tu l'as indiqué le code et nommé mon tableau REF j'ai toujours une erreur pour la ligne :

ListObjects(1).Range.AutoFilter Field:=7, Criterial :="SUPPR"

J'ai bien la colonne G qui apparaît avec les SUPPR mais la macro ne les supprime pas

Le 19/04/2021 à 11:52

J'ai essayé de mettre le nom de mon tableau à la place du ListObjects(1) j'ai mis ListObject("Nom_Tableau") mais j'ai toujours la même erreur

Le 19/04/2021 à 11:52

Bonjour,

Bon si vous avez SUPPR qui apparaît c'est déjà ça !
A tout hasard, avez-vous déjà un filtre appliqué sur ce tableau ? Si oui il faut qu'il soit réinitialisé avant l'application du nouveau filtre via le .showalldata que j'applique à la fin de ma macro.
Le message d'erreur reste le même ?

Cdlt,

Le 19/04/2021 à 11:58

Re,

Xorsankukai, pourriez vous m'expliquer votre macro s'il vous plaît? Par exemple si les références et les situations ne sont pas dans les mêmes colonnes, que dois-je changer?

Sub test()
 Dim dl As Long, tablo, tabloR(), k As Long, i As Long

  With Sheets("Extraction Stock") '.........................agit sur cette feuille
   dl = .Range("A" & Rows.Count).End(xlUp).Row '............dernière ligne
   tablo = .Range("A1:F" & dl) '............................définit le tableau virtuel de données

   Application.ScreenUpdating = False '.....................désactive le rafraichissement de l'écran

    k = 0
    For i = 2 To UBound(tablo, 1) '.........................boucle sur toutes les lignes du tableau virtuel
      ReDim Preserve tabloR(1 To 6, 1 To k + 1) '...........redimensionne le second tableau tabloR
      'Si la Référence fait partie de la liste (nommée ListeRef) où si elle n'en fait pas partie mais que Situ = STK
       If Application.CountIf([Listeref], tablo(i, 4)) Or Not Application.CountIf([Listeref], tablo(i, 4)) And tablo(i, 6) = "STK" Then
       For J = 1 To 6
        tabloR(J, 1 + k) = tablo(i, J) 'on écrit les données dans tabloR
       Next J
    k = 1 + k
        End If
    Next i
     With Sheets("Résultat") '................................agit sur cette feuille
      .Activate
      .Range("A1").CurrentRegion.Offset(1, 0).ClearContents '...efface les données existantes à partir de la ligne 2
      On Error Resume Next
      .Range("A2").Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR) '...écrit le tabloR transposé à partir de A2
     End With
   End With
End Sub
  • tablo=.range("A1:F" &dl) :plage de données à adapter
  • 6: car 6 colonnes....à adapter
  • tablo(i,4) :correspond à la colonne PN
  • tablo(i,6) :correspond à la colonne Situ

Cordialement,

Le 19/04/2021 à 12:01

Non je n'ai aucun filtre d'appliqué avant. J'ai l'erreur suivante : "Erreur définie par l'application ou par l'objet"

Cela vous aiderait-il d'avoir mon fichier?

Le 19/04/2021 à 12:06

Bonjour,

Oui vous pouvez me le transmettre en MP si vous avez des données confidentielles car là j'avoue que je sèche n'ayant aucun soucis sur le fichier transmis.

Cdlt,

Le 19/04/2021 à 12:12

Re,

dit @xorsankukai : En effet j'ai encore foutu le calcul manuel en début de code ... Avec celui posté ci-dessus j'ai un résultat de 2753 lignes sans erreur ..

Chez moi , il n'y a rien à faire, la formule ne retourne aucun résultat,

Je ne comprends pas....mais je n'ai pas les idées claires (j'ai bossé de nuit,)..

Sinon, effectivement, je trouve également 2753 lignes,

Cordialement,

Rechercher des sujets similaires à "supprimer ligne fonction reference statut"