rechercheV résultat different a chaque fois

[jamespatagueul]

Bonjour la forum,
je cherche a faire un rechercheV sur des cellules par liste déroulante, mais pour une catégorie j'ai plusieurs "résultat".
Je souhaite qu'a chaque fois que je choisi la catégorie "A", le résultat soit ligne +1.

Merci de votre aide

 

[job75]

Re,

En fait le VBA est très utile si l'on nomme les tableaux encadrés.

Voyez le fichier joint et cette fonction macro (à placer dans un module standard) :

Dim list As Range 'mémorise la variable

Function RechercheSuite()
Dim c As Range, col As Variant, nom As Name, T As Range, P As Range, n&
Application.Volatile
Set c = Application.Caller.Offset(, -1) 'cellule à gauche
If list Is Nothing Then Set list = [liste] 'variable déterminée une seule fois
col = Application.Match(c, list, 0)
If IsError(col) Then RechercheSuite = "": Exit Function
'---détermination du tableau T de la cellule appelante---
For Each nom In ThisWorkbook.Names
    If nom.Name Like "Table#*" Then If Not Intersect(c, Range(nom.Name)) Is Nothing _
        Then Set T = Range(nom.Name): Exit For
Next
'---traitement des autres tableaux---
For Each nom In ThisWorkbook.Names
    If nom.Name Like "Table#*" Then
        Set P = Range(nom.Name)
        If P.Row < T.Row Or P.Row = T.Row And P.Column < T.Column Then _
            n = n + Application.CountIf(P, c) 'NB.SI
    End If
Next
'---traitement du tableau T---
n = n + Application.CountIf(T.Resize(c.Row - T.Row + 1), c)
RechercheSuite = list(n + 1, col)
End Function

Il n'y a pas besoin de contrôler les entrées à l'extérieur des tableaux.

Noter que pour chaque rangée les tableaux doivent être sur la même ligne mais les hauteurs peuvent être différentes.

Edit : pour réduire la durée d'exécution :

- j'ai remplacé Evaluate(nom.Name) par Range(nom.Name)

- j'ai introduit la variable mémorisée list.

A+

 

[job75]

Bonjour le fil, le forum,

En terme de rapidité des calculs la fonction VBA se traîne un peu, voyez les fichiers joints.

Les formules Excel (volatiles) sont 5 fois plus rapides chez moi (2,5 ms contre 12,5 ms).

Bonne journée.

 

[job75]

Re,

A force de tester j'ai pu réduire notablement la durée des calculs de la fonction VBA.

Les posts #16 et #17 ont bien sûr été modifiés.

A+

 

[job75]

Bonjour le fil, le forum,

Si l'on veut traiter les tableaux dans l'ordre de leur numérotation c'est plus simple et plus rapide :

Dim list As Range 'mémorise la variable

Function RechercheSuite()
Dim c As Range, col As Variant, i&, P As Range, T As Range, n&
Application.Volatile
Set c = Application.Caller.Offset(, -1) 'cellule à gauche
If list Is Nothing Then Set list = [liste] 'variable déterminée une seule fois
col = Application.Match(c, list, 0)
If IsError(col) Then RechercheSuite = "": Exit Function
'---traitement des tableaux---
On Error Resume Next
For i = 1 To 99
    Set P = Nothing 'RAZ
    Set P = Range("Table" & Format(i, "00"))
    If Not P Is Nothing Then
        If Not Intersect(c, P) Is Nothing Then Set T = P: Exit For
        n = n + Application.CountIf(P, c)
    End If
Next
On Error GoTo 0
'---traitement du dernier tableau étudié---
n = n + Application.CountIf(T.Resize(c.Row - T.Row + 1), c)
RechercheSuite = list(n + 1, col)
End Function

Ici on suppose un maximum de 99 tableaux avec des nom numérotés comme indiqué.

Les tableaux peuvent être placés n'importe où et il peut y avoir des "trous" dans la numérotation.

Fichier (2).

Bonne journée.

 

[job75]

Bonjour le fil, le forum,

Toujours en traitant les tableaux dans l'ordre de leur numérotation mais cette fois avec des en-têtes.

Dans ThisWorkbook :

Private Sub Workbook_Open()
Feuil2.[A1] = Feuil2.[A1] 'déclenche la Worksheet_Change
Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

Dans la feuille "resultat" de CodeName Feuil2 :

Private Sub Worksheet_Change(ByVal Target As Range)
Static NbNom& 'mémorise la variable
Dim i&, nom$, r As Range, j&
On Error Resume Next
If Target Like "Table*" Or Application.CountIf(UsedRange, "Table*") <> NbNom Then
    On Error GoTo 0
    NbNom = Application.CountIf(UsedRange, "Table*")
    Set Tableaux = Nothing 'RAZ
    For i = 1 To 99 'maximum à adapter
        nom = "Table" & i 'à adapter
        Set r = Cells.Find(nom, , xlValues, xlWhole)
        If Not r Is Nothing Then
            j = 2
            While r(j, 2).HasFormula: j = j + 1: Wend
            If j > 2 Then
                Set r = r(2).Resize(j - 2)
                Set Tableaux = Union(IIf(Tableaux Is Nothing, r, Tableaux), r)
            End If
        End If
    Next
    Calculate
End If
End Sub

Dans Module1 :

Public Tableaux As Range 'mémorise la variable réinitialisée dans la Worksheet_Change
Dim list As Range  'mémorise la variable

Function RechercheSuite()
Dim c As Range, col As Variant, P As Range, T As Range, n&
Application.Volatile
Set c = Application.Caller.Offset(, -1) 'cellule à gauche
If list Is Nothing Then Set list = [liste] 'variable déterminée une seule fois
col = Application.Match(c, list, 0)
If IsError(col) Then RechercheSuite = "": Exit Function
'---traitement des tableaux---
For Each P In Tableaux.Areas
    If Not Intersect(c, P) Is Nothing Then Set T = P: Exit For
    n = n + Application.CountIf(P, c)
Next
'---traitement du dernier tableau étudié---
n = n + Application.CountIf(T.Resize(c.Row - T.Row + 1), c)
RechercheSuite = list(n + 1, col)
End Function

C'est un peu plus rapide.

Fichier (3).

Edit : j'ai testé avec 72 tableaux entièrement remplis contenant au total 720 données.

Les 720 formules avec la fonction VBA se recalculent chez moi en 0,60 seconde, c'est acceptable.

Le même fichier avec les formules Excel se recalcule en 0,10 seconde...

Bonne journée.