Simplification d'un code

Voici mon problème.

J'ai une feuille de calcule ou il y a beaucoup d'entrée (+ 40k lignes)

Je voudrai trier ces lignes sur via une plage de date et supprimer les lignes qui ne rentrent pas dans ces conditions.

Voici le code que j'ai écrits pour cela, il fonctionne mais est horriblement long

Function date_debut()

Dim fday As Date

Dim lday As Date

Sheets("production annuelle").Select

Selection.EntireRow(1).Delete

Selection.EntireColumn(1).Delete

k = Sheets("Production annuelle").Range("A" & Rows.Count).End(xlUp).Row

m = k - 1

debut:

fday = InputBox("Quelle est la date de début de l'étude? (JJ/MM/AAAA)")

lday = InputBox("Quelle est la date de début de l'étude? (JJ/MM/AAAA)")

If fday > lday Then

MsgBox ("Dernier jour antérieur à Premier jour, entrez des dates correctes!")

GoTo debut

Else

End If

For i = 2 To k

If Range("J" & i).Value < fday Or Range("J" & i).Value > lday Then

Range("J" & i).Select

Selection.EntireRow.Delete

i = i - 1

If i = k Then

GoTo suite

Else

End If

k = Sheets("Production annuelle").Range("A" & Rows.Count).End(xlUp).Row

Else

End If

Next i

suite:

End Function

Mon problème est donc, avez vous une solution pour simplifier ce code?

D'avance merci

Bonjour

Une entête en cellule A1

A tester

Sub date_debut()
Dim fday As Date
Dim lday As Date
Dim DerLig As Long

'  Sheets("production annuelle").Select
'  Selection.EntireRow(1).Delete
'  Selection.EntireColumn(1).Delete

  With Sheets("Production annuelle")
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row

debut:
    fday = InputBox("Quelle est la date de début de l'étude? (JJ/MM/AAAA)")
    lday = InputBox("Quelle est la date de début de l'étude? (JJ/MM/AAAA)")
    If fday > lday Then
      MsgBox ("Dernier jour antérieur à Premier jour, entrez des dates correctes!")
      GoTo debut
    End If

    .Range("A1:A" & DerLig).AutoFilter field:=1, Criteria1:="<" & CSng(fday), Operator:=xlOr, Criteria2:=">" & CSng(lday)
    If Application.Subtotal(103, .Columns("A")) > 1 Then
      .Range("A2:A" & DerLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    .AutoFilterMode = False
  End With
End Sub

Merci c'est parfait.

Rechercher des sujets similaires à "simplification code"