Recherchev à partir de la dernière ligne sur plusieurs onglets

fleurs59 · 4 Octobre 2017

Bonjour à tous,

Je souhaite faire une recherchev sur plusieurs onglets mais en affichant la dernière occurrence.

Actuellement j'ai cette formule :
=SI(K8="";"";RECHERCHEV(K8;INDIRECT(INDEX($T$2:$T$16;EQUIV(VRAI;(NB.SI(INDIRECT($T$2:$T$16&"!$A$2:A300");K8)>0);0))&"!$A$2:F300");6;1))

La colonne K étant la valeur cherchée, la colonne T la liste des noms de mes onglets, la colonne A est la colonne où se trouve ma valeur cherchée dans la matrice de recherche.

Cette formule fonctionne pour la recherchev dans plusieurs onglets, mais elle m'affiche le premier résultat trouvé, or je souhaite obtenir le dernier.

J'ai essayé de coupler cette formule avec une autre formule trouvée sur le net pour rechercher la dernière occurrence :
=INDEX(INDIRECT(INDEX($T$2:$T$16;EQUIV(VRAI;(NB.SI(INDIRECT($T$2:$T$16&"!$A$2:A300");K14)>0);0))&"!$A$2:F300");MAX(SI($T$2:$T$16&"!A$2:A$30=K14;LIGNE($T$2:$T$16&"!A$2:A$300)))-1;6)

Mais ça ne fonctionne pas...

Fichier en PJ.

D'avance un grand merci !

Dugenou · 4 Octobre 2017

Bonjour,
J'ai bien une formule qui fonctionne, mais les temps de calculs sont peu acceptables
voir pj

fleurs59 · 4 Octobre 2017

Dugenou à dit:
Bonjour,
J'ai bien une formule qui fonctionne, mais les temps de calculs sont peu acceptables
voir pj

C'est parfait !! Merci beaucoup !

job75 · 5 Octobre 2017

Bonsoir fleurs59, Dugenou,

Ah bon c'est parfait ? Je pense que la dernière occurrence doit être la dernière date, pas la ligne.

Donc pour le client "229792" on doit obtenir "RAPPELER" en Feuil1!L6.

Et plutôt que des formules Excel lourdes il vaut mieux cette fonction VBA dans un module standard :

Code:

Function DerVal(Client$, Agent$, feuil$, ColClient%, ColAgent%, ColDate%, ColDest%)
Dim t, i&, dat, datemax As Date, lig&
DerVal = ""
Client = Trim(Client): Agent = Trim(Agent) 'en cas d'espaces superflus...
On Error Resume Next 'si la feuille feuil n'existe pas
t = Sheets(feuil).UsedRange 'matrice, plus rapide
On Error GoTo 0
If Client = "" Or Agent = "" Or Not IsArray(t) Then Exit Function
For i = 1 To UBound(t)
  If Trim(t(i, ColClient)) = Client And Trim(t(i, ColAgent)) = Agent Then
    dat = t(i, ColDate)
    If IsDate(dat) Then dat = CDate(dat): If dat > datemax Then datemax = dat: lig = i
  End If
Next
If lig Then DerVal = t(lig, ColDest): If IsDate(DerVal) Then DerVal = CDate(DerVal)
End Function

En Feuil1 les formules des colonnes L et N sont recalculées quand on modifie les cellules jaunes.

Ou quand on active la feuille grâce à cette macro dans le code de la feuille :

Code:

Private Sub Worksheet_Activate()
[L2] = [L2] 'entraîne le recalcul des formules
End Sub

PS : la feuille "8611822B" est particulièrement mal fichue avec des dates qui sont des textes et des espaces superflus après "Cindy", mais ma fonction ne s'y laisse pas prendre !!!

Fichier .xlsm joint.

Bonne nuit.

Dugenou · 5 Octobre 2017

Bravo Job,
Tu sais que je suis un bourrin : oui il était demandé la dernière ligne et pas la dernière date et ce n'est pas logique. Je regrette bien de ne pas manipuler le VBA comme toi car ma solution était plus que lourdingue. En fait ce qui m'a intéressé c'est cette manip de feuilles en matriciel à partir d'une liste : je connaissait pas la technique et j'aurai même pas cru que ça marchait.
Cordialement

job75 · 5 Octobre 2017

Bonjour fleurs59, Dugenou,

Si l'on veut qu'en Feuil1 la colonne K se remplisse automatiquement mettre dans le code de la feuille :

Code:

Private Sub Worksheet_Activate()
Dim agent$, t, d As Object, i&
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Range("K4:O" & Rows.Count) = "" 'RAZ
agent = Trim([O2])
On Error Resume Next 'si la feuille n'existe pas
t = Sheets(CStr([L2])).UsedRange.Resize(, 8) 'matrice, plus rapide
On Error GoTo 0
If agent = "" Or Not IsArray(t) Then GoTo 1
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If Trim(t(i, 1)) <> "" And Trim(t(i, 8)) = agent Then d(t(i, 1)) = ""
Next
If d.Count = 0 Then GoTo 1
With [K4].Resize(d.Count)
  .Value = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
  .Sort .Cells(1), xlAscending, Header:=xlNo 'tri
  .Offset(, 1) = "=DerVal(K4,O$2,L$2,1,8,7,6)"
  .Offset(, 2) = "=ROWS(M$4:M4)" 'index, il sert à quoi ???
  .Offset(, 3) = "=DerVal(K4,O$2,L$2,1,8,7,7)"
  'ajouter la formule pour la colonne O
End With
1 With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [L2,O2]) Is Nothing Then Worksheet_Activate 'lance la macro
End Sub

Fichier (2).

J'ai testé avec en 2ème feuille 1000 N° client différents, la macro s'exécute en 9 secondes.

C'est donc assez long malgré le Dictionary et le tableau VBA.

Edit : on pourrait gagner 2,5 secondes en mémorisant l'objet Dictionary.

Comme le code est alors nettement plus compliqué ça n'en vaut pas la chandelle.

A+

job75 · 5 Octobre 2017

Re,

Ah mais pour vraiment gagner du temps il faut mémoriser aussi la variable t.

Le code dans Module1 :

Code:

Public t, d As Object 'mémorise les variables

Function DerVal(Client$, agent$, feuil$, ColClient%, ColAgent%, ColDate%, ColDest%)
Dim i&, dat, datemax As Date, lig&
DerVal = ""
Client = Trim(Client): agent = Trim(agent) 'en cas d'espaces superflus...
On Error Resume Next 'si la feuille feuil n'existe pas
If Not IsArray(t) Then t = Sheets(feuil).UsedRange 'matrice, plus rapide
On Error GoTo 0
If Client = "" Or agent = "" Or Not IsArray(t) Then Exit Function
If d Is Nothing Then
  For i = 1 To UBound(t)
    If Trim(t(i, ColClient)) = Client And Trim(t(i, ColAgent)) = agent Then
      dat = t(i, ColDate)
      If IsDate(dat) Then dat = CDate(dat): If dat > datemax Then datemax = dat: lig = i
    End If
  Next
  If lig Then DerVal = t(lig, ColDest)
Else
  If d(Client) Then DerVal = t(d(Client), ColDest)
End If
If IsDate(DerVal) Then DerVal = CDate(DerVal)
End Function

Et dans Feuil1 :

Code:

Private Sub Worksheet_Activate()
Dim agent$, i&, x$, dat
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Range("K4:O" & Rows.Count) = "" 'RAZ
agent = Trim([O2])
On Error Resume Next 'si la feuille n'existe pas
t = Sheets(CStr([L2])).UsedRange.Resize(, 8) 'matrice, plus rapide
On Error GoTo 0
If agent = "" Or Not IsArray(t) Then GoTo 1
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  x = Trim(t(i, 1))
  If x <> "" And Trim(t(i, 8)) = agent Then
    dat = t(i, 7)
    If d.exists(x) Then
      If IsDate(dat) Then If CDate(dat) > t(d(x), 7) Then d(x) = i 'mémorise la ligne
    Else
      d(x) = IIf(IsDate(dat), i, 0)
    End If
  End If
Next
If d.Count = 0 Then GoTo 1
With [K4].Resize(d.Count)
  .Value = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
  .Sort .Cells(1), xlAscending, Header:=xlNo 'tri
  .Offset(, 1) = "=DerVal(K4,O$2,L$2,1,8,7,6)"
  .Offset(, 2) = "=ROWS(M$4:M4)" 'index, il sert à quoi ???
  .Offset(, 3) = "=DerVal(K4,O$2,L$2,1,8,7,7)"
  'ajouter la formule pour la colonne O
End With
1 t = Empty 'RAZ
Set d = Nothing 'RAZ
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [L2,O2]) Is Nothing Then Worksheet_Activate 'lance la macro
End Sub

Fichier (3).

Avec 1000 lignes sans doublons en 2ème feuille la durée d'exécution est de 0,08 seconde.

C'est quasi instantané, l'honneur du Dictionary est sauf

A+

job75 · 6 Octobre 2017

Bonjour le fil, le forum,

Dans le fichier (3) précédent Feuil1 est protégée, j'ai ajouté dans ThisWorkbook :

Code:

Private Sub Workbook_Open()
Feuil1.Protect "fleurs59", UserInterfaceOnly:=True, _
  AllowFormattingCells:=True, AllowFormattingColumns:=True
Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

Bonne journée.

job75 · 6 Octobre 2017

Re,

Si Feuil1 est bien protégée à l'ouverture du fichier, la fonction se réduit à sa plus simple expression :

Code:

Public t, d As Object 'mémorise les variables

Function DerVal(Client$, ColDest%)
DerVal = t(d(Client), ColDest)
If IsDate(DerVal) Then DerVal = CDate(DerVal)
End Function

Dans la Worksheet_Activate les formules (modifiées) sont remplacées par leurs valeurs.

Fichier (3 bis).

Edit : juste pour voir j'ai testé avec 10 000 lignes (sans doublon) dans la 2ème feuille.

La Worksheet_Activate s'exécute alors en 0,6 seconde.

A+

Recherchev à partir de la dernière ligne sur plusieurs onglets

fleurs59

XLDnaute Nouveau

Pièces jointes

Dugenou

XLDnaute Barbatruc

Pièces jointes

fleurs59

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Dugenou

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires