Suppression ligne avec condition de date

Le 04/04/2013 à 11:51

Bonjour à tous,

Je tourne un peu en rond car mes connaissances sont limitées donc j'ai opté pour la demande d'aide de personnes confirmées.

Voici ce que j'essaie de faire dans ma macro :

Je traite un fichier excel avec en colonne G et à partir de la ligne 2 une suite de lignes avec des dates du style 04/04/2013, j'aimerai coller en amont de ma macro actuelle une suppression des lignes ayant pour date le mois précédent à celle du jour.

Voici ma macro à ce jour certainement pas très clean , si vous avez d'ailleurs l'astuce pour remplacer les activewindow.scrollrow = je veux bien pour comprendre le principe.

Merci beaucoup d'avance.

Sub Cotations()
'
' Cotations Macro
'

'
    Application.ScreenUpdating = False
    Dim lig As Long
    For lig = [G8000].End(xlUp).Row To 1 Step -1
        If IsDate(Cells(lig, 1)) And Cells(lig, 1) < MOIS((AUJOURDHUI())-1;31) Then Rows(lig).Delete
    Next lig
    Dim myRange As Range
Dim myDate As Date

Range("G2:G8000").Select 'Je commence ici à la 2ème ligne pour eviter la cellule C1 ou il y a du texte et pas une date
For Each myRange In Selection
If myRange.Value = "" Then
Exit For
Else
myDate = myRange.Value
myRange.NumberFormat = "@"
myRange.Value = Format(myDate, "dd/mm/yyyy")
End If
Next
    Columns("C:C").Select
    ActiveWorkbook.Worksheets("import").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("import").Sort.SortFields.Add Key:=Range("C1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("import").Sort
        .SetRange Range("A2:Q2894")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Replace What:="N° ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="-00", Replacement:="-v", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="-0", Replacement:="-v", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Selection.Replace What:=" ", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.SmallScroll ToRight:=3
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("R2").Select
    Selection.AutoFill Destination:=Range("R2:R8000"), Type:=xlFillDefault
    Range("R2:R8000").Select
    Range("R8000").Select
    ActiveWindow.ScrollRow = 2898
    ActiveWindow.ScrollRow = 2893
    ActiveWindow.ScrollRow = 2879
    ActiveWindow.ScrollRow = 2869
    ActiveWindow.ScrollRow = 2855
    ActiveWindow.ScrollRow = 2830
    ActiveWindow.ScrollRow = 2811
    ActiveWindow.ScrollRow = 2782
    ActiveWindow.ScrollRow = 2743
    ActiveWindow.ScrollRow = 2671
    ActiveWindow.ScrollRow = 2632
    ActiveWindow.ScrollRow = 2599
    ActiveWindow.ScrollRow = 2555
    ActiveWindow.ScrollRow = 2517
    ActiveWindow.ScrollRow = 2478
    ActiveWindow.ScrollRow = 2439
    ActiveWindow.ScrollRow = 2391
    ActiveWindow.ScrollRow = 2352
    ActiveWindow.ScrollRow = 2304
    ActiveWindow.ScrollRow = 2265
    ActiveWindow.ScrollRow = 2227
    ActiveWindow.ScrollRow = 2179
    ActiveWindow.ScrollRow = 2140
    ActiveWindow.ScrollRow = 2096
    ActiveWindow.ScrollRow = 2063
    ActiveWindow.ScrollRow = 2014
    ActiveWindow.ScrollRow = 1976
    ActiveWindow.ScrollRow = 1928
    ActiveWindow.ScrollRow = 1889
    ActiveWindow.ScrollRow = 1850
    ActiveWindow.ScrollRow = 1802
    ActiveWindow.ScrollRow = 1754
    ActiveWindow.ScrollRow = 1710
    ActiveWindow.ScrollRow = 1662
    ActiveWindow.ScrollRow = 1614
    ActiveWindow.ScrollRow = 1570
    ActiveWindow.ScrollRow = 1527
    ActiveWindow.ScrollRow = 1488
    ActiveWindow.ScrollRow = 1440
    ActiveWindow.ScrollRow = 1406
    ActiveWindow.ScrollRow = 1367
    ActiveWindow.ScrollRow = 1334
    ActiveWindow.ScrollRow = 1305
    ActiveWindow.ScrollRow = 1276
    ActiveWindow.ScrollRow = 1256
    ActiveWindow.ScrollRow = 1242
    ActiveWindow.ScrollRow = 1227
    ActiveWindow.ScrollRow = 1213
    ActiveWindow.ScrollRow = 1189
    ActiveWindow.ScrollRow = 1179
    ActiveWindow.ScrollRow = 1165
    ActiveWindow.ScrollRow = 1150
    ActiveWindow.ScrollRow = 1136
    ActiveWindow.ScrollRow = 1121
    ActiveWindow.ScrollRow = 1102
    ActiveWindow.ScrollRow = 1087
    ActiveWindow.ScrollRow = 1063
    ActiveWindow.ScrollRow = 1049
    ActiveWindow.ScrollRow = 1029
    ActiveWindow.ScrollRow = 1005
    ActiveWindow.ScrollRow = 981
    ActiveWindow.ScrollRow = 957
    ActiveWindow.ScrollRow = 928
    ActiveWindow.ScrollRow = 904
    ActiveWindow.ScrollRow = 875
    ActiveWindow.ScrollRow = 841
    ActiveWindow.ScrollRow = 807
    ActiveWindow.ScrollRow = 774
    ActiveWindow.ScrollRow = 740
    ActiveWindow.ScrollRow = 706
    ActiveWindow.ScrollRow = 672
    ActiveWindow.ScrollRow = 648
    ActiveWindow.ScrollRow = 614
    ActiveWindow.ScrollRow = 585
    ActiveWindow.ScrollRow = 551
    ActiveWindow.ScrollRow = 532
    ActiveWindow.ScrollRow = 513
    ActiveWindow.ScrollRow = 489
    ActiveWindow.ScrollRow = 474
    ActiveWindow.ScrollRow = 460
    ActiveWindow.ScrollRow = 445
    ActiveWindow.ScrollRow = 431
    ActiveWindow.ScrollRow = 416
    ActiveWindow.ScrollRow = 402
    ActiveWindow.ScrollRow = 392
    ActiveWindow.ScrollRow = 378
    ActiveWindow.ScrollRow = 358
    ActiveWindow.ScrollRow = 344
    ActiveWindow.ScrollRow = 329
    ActiveWindow.ScrollRow = 305
    ActiveWindow.ScrollRow = 291
    ActiveWindow.ScrollRow = 271
    ActiveWindow.ScrollRow = 252
    ActiveWindow.ScrollRow = 228
    ActiveWindow.ScrollRow = 204
    ActiveWindow.ScrollRow = 184
    ActiveWindow.ScrollRow = 160
    ActiveWindow.ScrollRow = 146
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 88
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 1
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Prix Final"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "=RC[-16]&""-""&RC[-12]&""-""&RC[-17]"
    Range("S1").Select
    Selection.AutoFill Destination:=Range("S1:S8000"), Type:=xlFillDefault
    Range("S1:S8000").Select
    ActiveWindow.ScrollRow = 2898
    ActiveWindow.ScrollRow = 2893
    ActiveWindow.ScrollRow = 2884
    ActiveWindow.ScrollRow = 2864
    ActiveWindow.ScrollRow = 2850
    ActiveWindow.ScrollRow = 2821
    ActiveWindow.ScrollRow = 2797
    ActiveWindow.ScrollRow = 2768
    ActiveWindow.ScrollRow = 2734
    ActiveWindow.ScrollRow = 2700
    ActiveWindow.ScrollRow = 2661
    ActiveWindow.ScrollRow = 2565
    ActiveWindow.ScrollRow = 2517
    ActiveWindow.ScrollRow = 2459
    ActiveWindow.ScrollRow = 2338
    ActiveWindow.ScrollRow = 2280
    ActiveWindow.ScrollRow = 2222
    ActiveWindow.ScrollRow = 2116
    ActiveWindow.ScrollRow = 2063
    ActiveWindow.ScrollRow = 2010
    ActiveWindow.ScrollRow = 1956
    ActiveWindow.ScrollRow = 1850
    ActiveWindow.ScrollRow = 1792
    ActiveWindow.ScrollRow = 1725
    ActiveWindow.ScrollRow = 1667
    ActiveWindow.ScrollRow = 1532
    ActiveWindow.ScrollRow = 1474
    ActiveWindow.ScrollRow = 1416
    ActiveWindow.ScrollRow = 1353
    ActiveWindow.ScrollRow = 1242
    ActiveWindow.ScrollRow = 1189
    ActiveWindow.ScrollRow = 1131
    ActiveWindow.ScrollRow = 1020
    ActiveWindow.ScrollRow = 971
    ActiveWindow.ScrollRow = 933
    ActiveWindow.ScrollRow = 865
    ActiveWindow.ScrollRow = 798
    ActiveWindow.ScrollRow = 759
    ActiveWindow.ScrollRow = 725
    ActiveWindow.ScrollRow = 691
    ActiveWindow.ScrollRow = 638
    ActiveWindow.ScrollRow = 619
    ActiveWindow.ScrollRow = 600
    ActiveWindow.ScrollRow = 576
    ActiveWindow.ScrollRow = 556
    ActiveWindow.ScrollRow = 542
    ActiveWindow.ScrollRow = 522
    ActiveWindow.ScrollRow = 508
    ActiveWindow.ScrollRow = 484
    ActiveWindow.ScrollRow = 465
    ActiveWindow.ScrollRow = 450
    ActiveWindow.ScrollRow = 436
    ActiveWindow.ScrollRow = 421
    ActiveWindow.ScrollRow = 407
    ActiveWindow.ScrollRow = 392
    ActiveWindow.ScrollRow = 382
    ActiveWindow.ScrollRow = 363
    ActiveWindow.ScrollRow = 349
    ActiveWindow.ScrollRow = 334
    ActiveWindow.ScrollRow = 320
    ActiveWindow.ScrollRow = 305
    ActiveWindow.ScrollRow = 291
    ActiveWindow.ScrollRow = 281
    ActiveWindow.ScrollRow = 271
    ActiveWindow.ScrollRow = 262
    ActiveWindow.ScrollRow = 247
    ActiveWindow.ScrollRow = 242
    ActiveWindow.ScrollRow = 238
    ActiveWindow.ScrollRow = 223
    ActiveWindow.ScrollRow = 218
    ActiveWindow.ScrollRow = 213
    ActiveWindow.ScrollRow = 209
    ActiveWindow.ScrollRow = 204
    ActiveWindow.ScrollRow = 199
    ActiveWindow.ScrollRow = 194
    ActiveWindow.ScrollRow = 189
    ActiveWindow.ScrollRow = 180
    ActiveWindow.ScrollRow = 175
    ActiveWindow.ScrollRow = 170
    ActiveWindow.ScrollRow = 160
    ActiveWindow.ScrollRow = 156
    ActiveWindow.ScrollRow = 146
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 131
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 112
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 98
    ActiveWindow.ScrollRow = 93
    ActiveWindow.ScrollRow = 78
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 1
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.Quit
End Sub
Le 04/04/2013 à 15:04

Bonjour

En voyant ton fichier, il sera plus facile de trouver une solution à ton problème

Tu y expliques ce que tu veux faire

D'après ce que j'ai compris ce sont les dates du mois précédent à celui en cours

hdavid a écrit :

l'astuce pour remplacer les activewindow.scrollrow =

Tu les supprimes c'est tout

Le 04/04/2013 à 15:47

En fait, je souhaite avec le fichier joint supprimer automatiquement les lignes dont la date de la colonne G est plus ancienne que le mois en cours donc dans le cas présent on supprime la ligne 3 etc car à la base mon fichier fait 6000 lignes puis ensuite on exécute la macro que j'ai mis plus haut.

83promo-act.csv (747.00 Octets)
Le 04/04/2013 à 17:02

Bonjour

Remplaces le début de ta macro

  Application.ScreenUpdating = False
  For lig = [G8000].End(xlUp).Row To 2 Step -1
    If IsDate(Cells(lig, "G")) And Month(Cells(lig, "G")) < Month(Date) Then Rows(lig).Delete
  Next lig
Le 05/04/2013 à 12:15

Bonjour,

Suite à test cela fonctionne presque mais ne gère pas les années. Par exemple j'ai un 15/03/2014 qui a été enlevé alors que mars est le mois précédent mais l'année suivante, il aurait donc du rester.

Quelque chose à rajouter à la ligne de code ?

Merci.

Le 12/04/2013 à 21:13

Bonsoir

Une semaine sans Excel

Espérons que cela t'aidera

Le début de ta macro

Sub Cotations()
  Dim lig As Long
  Application.ScreenUpdating = False
  For lig = [G8000].End(xlUp).Row To 2 Step -1
    If IsDate(Cells(lig, "G")) Then
      If Cells(lig, "G") < DateSerial(Year(Date), Month(Date), 1) Then Rows(lig).Delete
    End If
  Next lig

Supprimera les dates inférieures au 1er du mois en cours

Le 15/04/2013 à 09:03

Bonjour,

Impeccable merci beaucoup pour l'aide.

Rechercher des sujets similaires à "suppression ligne condition date"