Supprimer lignes d'un tableau

[patoq]

Bonjour à tous,

Dans un classeur ,j'ai une extraction de base de données par MSQUERY d'environ 100000 lignes.
J'aimerais filtrer cette base en supprimant tous les enregistrements datant de plus de 90 jours.
Le problème : cette base s'alimente jour après jour donc j'aimerais garder tout le temps les enregistrements les plus récents ( 90j ).
J'ai une macro qui me permet de supprimer ce que je veux dedans (ça marche très bien mais c'est long).

Sub Test()
    Dim lCt As Long
    Dim oArea As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With ActiveSheet.ListObjects(1)
        .Range.AutoFilter Field:=3, Criteria1:="20140212"
        For Each oArea In .DataBodyRange.SpecialCells(xlCellTypeVisible).Areas
            For lCt = oArea.Rows.Count To 1 Step -1
                oArea.EntireRow.Rows(lCt).Delete
            Next
        Next
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Comme vous pouvez le voir , le formatage date dans l'extraction est AAAAMMJJ.

Mon but : filtrer sur 90 jours (avec 2 variables je pense; une correspondant à aujourd'hui et l'autre à aujourd'hui -90).
Si quelqu'un avait une méthode plus rapide pour filtrer et supprimer je suis preneur aussi.😉😉😛

Si tout cela n'est pas clair je peut fournir un échantillon du fichier à la demande.

Merci d'avance
Cdt
Patrice

 

[mromain]

Re : Supprimer lignes d'un tableau

Bonjour Patrice,

Vu que tu extrais tes données par MS-Query, il serait envisageable de mettre la condition (des 90 derniers jours) dans la requête MS-Query.

Qu'en penses-tu ?

A+

 

[patoq]

Re : Supprimer lignes d'un tableau

Bonjour romain,

Merci de m'avoir répondu.
J' y avais pensé mais je ne sais pas faire pour que ce soit glissant jour après jour.
J'arrive à mettre l'intervalle entre 2 dates dans ma requête mais pas d'aujourd'ui à moins 90.
J 'ai enregistré ma requête avec l'enregistreur si tu veut y jeter un oeil.

Sub Macro1()
   With ActiveWorkbook.Connections("Transaction").ODBCConnection
        .BackgroundQuery = True
        .CommandText = Array( _
        "SELECT FT_TRANSACTIONS_All.Warehouse, FT_TRANSACTIONS_All.""Transaction date"", FT_TRANSACTIONS_All.""Transaction iden" _
        , _
        "tity"", FT_TRANSACTIONS_All.""Libelle article"", FT_TRANSACTIONS_All.""Item number"", FT_TRANSACTIONS_All.""Transaction q" _
        , _
        "uantity - basic U/M"", FT_TRANSACTIONS_All.""Acquisition cost""" & Chr(13) & "" & Chr(10) & "FROM BPW_TEST_Datamarts.dbo.FT_TRANSACTIONS_All FT_TR" _
        , _
        "ANSACTIONS_All" & Chr(13) & "" & Chr(10) & "WHERE (FT_TRANSACTIONS_All.""Transaction identity""='WOM') AND (FT_TRANSACTIONS_All.""Transaction date" _
        , _
        """>=20140206) AND (FT_TRANSACTIONS_All.""Item number""<'90000' And FT_TRANSACTIONS_All.""Item number"" Not Like '3%') OR" _
        , _
        " (FT_TRANSACTIONS_All.""Transaction identity""='OID') AND (FT_TRANSACTIONS_All.""Transaction date"">=20140206) AND (FT_" _
        , _
        "TRANSACTIONS_All.""Item number""<'90000' And FT_TRANSACTIONS_All.""Item number"" Not Like '3%')" _
        )
        .CommandType = xlCmdSql
        .Connection = Array(Array( _
                ), Array("AGE=Français"))
        .RefreshOnFileOpen = False
        .SavePassword = True
        .SourceConnectionFile = ""
        .SourceDataFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With
    With ActiveWorkbook.Connections("Transaction")
        .Name = "Transaction"
        .Description = ""
    End With
    ActiveWorkbook.Connections("Transaction").Refresh
End Sub

Je pense que le parametre se met au niveau des dates (ex 20140206).

Merci d'avance pour ton aide
Cdt
Patrice

 

[mromain]

Re : Supprimer lignes d'un tableau

Re bonjour,

Tu peux essayer avec ce code (non testé) :

... (FT_TRANSACTIONS_All.""Transaction date"">=" & Format(Now - 90, "yyyymmdd") & ") AND ...

Sinon, tu peux aussi te passer du VBA en utilisant une cellule contenant la date voulue (=TEXTE(AUJOURDHUI()-90;"aaaammjj")) comme critère de ta requête. Cette même cellule peut se situer sur une feuille cachée à l'utilisateur.
Ensuite, tu ajoute une actualisation à l'ouverture du fichier, et tu n'as plus besoin de macros.

Si ça t'intéresse, la procédure est décrite dans ce tuto.

A+

 

[patoq]

Re : Supprimer lignes d'un tableau

Merci Romain le code fonctionne impeccable.
J' avia déja vu pour passer les critères dans une cellule mais c'était du chinois pour moi.
Je vais étudier le tuto car ça m'intéresse beaucoup de progresser sur les requêtes paramétrées.

Merci encore
Cdt
Pat

 

[job75]

Re : Supprimer lignes d'un tableau

Bonjour patoq, mromain,

Voici 2 macros pour les 2 cas de figure, "vraies" dates et "fausses" dates :

Sub Filtrer_vraies_dates()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet.ListObjects(1).Range
  .Columns(2).EntireColumn.Insert 'colonne auxiliaire
  .Columns(2).FormulaR1C1 = "=LN((RC[2]>=" & CLng(Date) - 90 & ")*(RC[2]<=" & CLng(Date) & "))"
  .Columns(2) = .Columns(2).Value 'supprime les formules
  .Sort .Columns(2), xlAscending, Header:=xlYes 'tri pour accélérer
  .Columns(2).Cells(1) = "" 'car ligne des titres
  On Error Resume Next 'si aucune valeur d'erreur
  .Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(2).EntireColumn.Delete
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Sub Filtrer_fausses_dates()
Dim jour$, jour90$
jour = Format(Date, "yyyymmdd")
jour90 = Format(Date - 90, "yyyymmdd")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet.ListObjects(1).Range
  .Columns(2).EntireColumn.Insert 'colonne auxiliaire
  .Columns(2).FormulaR1C1 = "=LN((RC[2]>=" & jour90 & ")*(RC[2]<=" & jour & "))"
  .Columns(2) = .Columns(2).Value 'supprime les formules
  .Sort .Columns(2), xlAscending, Header:=xlYes 'tri pour accélérer
  .Columns(2).Cells(1) = "" 'car ligne des titres
  On Error Resume Next 'si aucune valeur d'erreur
  .Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(2).EntireColumn.Delete
End With
Application.Calculation = xlCalculationAutomatic
End Sub

L'exécution est rapide car les lignes à supprimer sont renvoyées en bas du tableau par le tri.

Fichiers joints.

A+

 

[patoq]

Re : Supprimer lignes d'un tableau

Bonjour job,

Merci de t'intéresser à mon problème ,je teste et je reviens vers toi .

Merci encore.

Cdt
Pat