Trouver la première et dernière ligne correspondant à un critère de date

Sebast · 23 Octobre 2013

Bonjour à toutes et à tous,

j'importe dans l'onglet Destination des données à stocker, qui transitent par l'onglet Origine
Dans Origine, j'extrais la date la plus lointaine et la plus proche et toutes les dates au sein de cette plage sont à supprimer dans Destination, avant remplacement par celles d'Origine

Le fichier joint est un tout petit extrait mais avec les données réelles, ma méthode de purge est trop longue et je voudrais l'améliorer en ne balayant plus toute la base mais en définissant une plage
que je supprimerais d'un seul coup.
En effet, la boucle suivante n'est vraiment pas performante car je passe tout en revue, de la première à la dernière ligne … :

Code:

For i = dernlign To 2 Step -1
     If Cells(i, 1) >= Min_Tranche And Cells(i, 1) <= Max_Tranche Then Rows(i).Delete
Next i

Mon problème est que je ne sais pas comment trouver la ligne correspondant au critère de date donné.

Qui peut me dire comment trouver la première ligne correspondant au minimum d'une plage (critère=date) et la dernière ligne correspondant au maximum de la plage (critère=date) ?

Je pense que tout sera plus clair avec le fichier joint

Merci d'avance pour votre aide

Pierrot93 · 24 Octobre 2013

Re : Trouver la première et dernière ligne correspondant à un critère de date

Re,
utilise le code du post #2... si tu rajoutes l'opérateur = aux < et >, doit fonctionner en donnant le résultat que tu attends....

Sebast · 29 Octobre 2013

Re : Trouver la première et dernière ligne correspondant à un critère de date

Bonjour Pierrot, le fil,

j'ai un peu galéré mais finalement ça marche. J'ai suivi le conseil de Pierrot avec EQUIV (MATCH en VBA) et le résultat est impressionnant en terme de performance. Le fait de ne pas avoir à balayer la base avec une boucle permet un effacement quasi instantané ...
Pour ceux que ça pourrait intéresser, voici le code

Code:

Sub Supprimer_intervalle()
Dim DateDepuis As Long ' colonne contenant date est considérée ici comme long car calculs plus fiables
Dim DateJusquà As Long ' même si colonne date est bel et bien au format date
Dim LigneDepuis As Long
Dim LigneJusquà As Long


'--- Rechercher la date mini et la date maxi présentes dans la feuille "Origine"
With Sheets("Origine").UsedRange
    DateDepuis = WorksheetFunction.Min(.Columns(1))    ' colonne 1 contient la date
    DateJusquà = WorksheetFunction.Max(.Columns(1))
End With

MsgBox "La date la plus ancienne est le " & CDate(DateDepuis) & " et la date la plus récente est le " & CDate(DateJusquà)
' Cdate() pour transformer le chiffre en date



'--- Déterminer les lignes correspondant à l'intervalle vu plus haut
With Sheets("Destination").UsedRange

    .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes   ' on trie par date car les les lignes doivent être en ordre croissant pour fonction Match
    
    LigneDepuis = WorksheetFunction.Match(DateDepuis - 1, .Columns(1), 1) + 1
    LigneJusquà = WorksheetFunction.Match(DateJusquà, Columns(1), 1)
    
' Match fonctionne comme suit :
' a) Si le terme cherché n'existe pas, alors Excel prend la valeur immédiatement suivante
' b) Si le terme cherché existe plusieurs fois, Excel retient la dernière occurrence
' donc
' LigneJusquà : rien de particulier, avec Match critère 1, si le terme recherché apparaît plusieurs fois, c'est le ' dernier qui est retenu
' LigneDepuis : on se positionne sur le terme recherché inférieur (en ayant écrit DateDepuis - 1) et on ajoute 1 pour se mettre finalement sur le bon élément

     
    
    If LigneDepuis <= LigneJusquà Then
        MsgBox "Le bloc à supprimer va de la ligne n° " & LigneDepuis & " à la ligne n° " & LigneJusquà
        .Range(.Rows(LigneDepuis), .Rows(LigneJusquà)).Delete
    Else
        MsgBox "L'intervalle présent dans la feuille Origine allant du " & CDate(DateDepuis) & " au " & CDate(DateJusquà) & " n'existe pas dans la feuille Destination"
                
                
    End If
    
    
End With

End Sub

Sebast · 29 Octobre 2013

Re : Trouver la première et dernière ligne correspondant à un critère de date

Bonjour à toutes et à tous,

je renvoie ma réponse car je me suis rendu compte que mon dernier post n'était pas passé ...

j'ai cherché un peu partout et ai utilisé EQUIV comme Pierrot me le recommandait (Match en VBA)
C'est extrêmement rapide car pas de boucle quiu oblige à balayer la base ...
Pour ceux que ça intéresserait :

Code:

Sub Supprimer_intervalle()
Dim DateDepuis As Long ' colonne contenant date est considérée ici comme long car calculs plus fiables
Dim DateJusquà As Long ' même si colonne date est bel et bien au format date
Dim LigneDepuis As Long
Dim LigneJusquà As Long


'--- Rechercher la date mini et la date maxi présentes dans la feuille "Origine"
With Sheets("Origine").UsedRange
    DateDepuis = WorksheetFunction.Min(.Columns(1))    ' colonne 1 contient la date
    DateJusquà = WorksheetFunction.Max(.Columns(1))
End With

MsgBox "La date la plus ancienne est le " & CDate(DateDepuis) & " et la date la plus récente est le " & CDate(DateJusquà)
' Cdate() pour transformer le chiffre en date



'--- Déterminer les lignes correspondant à l'intervalle vu plus haut
With Sheets("Destination").UsedRange

    .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes   ' on trie par date car les les lignes doivent être en ordre croissant pour fonction Match
    
    LigneDepuis = WorksheetFunction.Match(DateDepuis - 1, .Columns(1), 1) + 1
    LigneJusquà = WorksheetFunction.Match(DateJusquà, Columns(1), 1)
    
' Match fonctionne comme suit :
' a) Si le terme cherché n'existe pas, alors Excel prend la valeur immédiatement suivante
' b) Si le terme cherché existe plusieurs fois, Excel retient la dernière occurrence
' donc
' LigneJusquà : rien de particulier, avec Match critère 1, si le terme recherché apparaît plusieurs fois, c'est le dernier qui est retenu
' LigneDepuis : on se positionne sur le terme recherché inférieur (en ayant écrit DateDepuis - 1) et on ajoute 1 pour se mettre finalement sur le bon élément

     
    
    If LigneDepuis <= LigneJusquà Then
        MsgBox "Le bloc à supprimer va de la ligne n° " & LigneDepuis & " à la ligne n° " & LigneJusquà
        '.Range(.Rows(LigneDepuis), .Rows(LigneJusquà)).Delete
    Else
        MsgBox "L'intervalle présent dans la feuille Origine allant du " & CDate(DateDepuis) & " au " & CDate(DateJusquà) & " n'existe pas dans la feuille Destination"
                
                
    End If
    
    
End With

End Sub

Trouver la première et dernière ligne correspondant à un critère de date

Sebast

XLDnaute Impliqué

Pièces jointes

Pierrot93

XLDnaute Barbatruc

Sebast

XLDnaute Impliqué

Sebast

XLDnaute Impliqué

Discussions similaires