equiv ou recherchev (cellules du champ de recherche comprises entre 1 et 12000car)

Ron2cuir

XLDnaute Nouveau
Bonjour,
petit nouveau XLD!
Désolé j'ai confondu discussion et conversation!!!
Ces fonctions ne prennent en compte que 256 car des cellules de champs (6000lignes).
qui a déja trouvé une solution (même avec vba) pour pallier cet inconvénient ?

Le retour doit être: numéro de ligne dans la table.
Merci de votre aide
 

Ron2cuir

XLDnaute Nouveau
Bonjour
l'argument peut exister dans plusieurs cellules du champ K (Feld)
voila ce que j'ai fait:
'*************************************************************************
Function EquivP(Argum, Feld As Range)
Dim OkAddress, Cold, Serche
'Cold = Feld.Address 'pour tester
Cold = Feld.Row - 1
Set Serche = Feld.Find(Argum, LookIn:=xlValues)
If Not Serche Is Nothing Then OkAddress = Serche.Row - 1 - Cold
EquivP = OkAddress
Set Serche = Nothing
End Function
'*************************************************************************
dans une autre feuille ma formule d'appel:
en K4 =1 ligne de haut de ma base 3500 lignes
en K5 =EQUIVp(Argum;INDIRECT("BaseImaJ!K"&MAX($K4+1;1)&":K3500"))
en K6 =EQUIVp(Argum;INDIRECT("BaseImaJ!K"&MAX($K5+1;1)&":K3500"))
ETC... sur 300 lignes
ça fonctionne presque! sauf que:
-Le premier élément trouvé donne un numéro de ligne -1 ????
-les éléments suivants ok
-le(s) dernier(s) élément(s) non trouvé(s) reprennent le numéro de ligne du dernier trouvé
J'espère être clair!
Merci
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Ron2cuir, bienvenue sur XLD,

Effectivement le nombre maximum de caractères est 255 pour les fonctions EQUIV RECHERCHEV et RECHERCHEH.

Voyez le fichier joint et ces 3 fonctions VBA pour lesquelles il n'y a plus de limite :
Code:
Option Compare Text 'la casse est ignorée

Function EquivPlus(X As Variant, R As Range) As Variant
If Not IsEmpty(X) And (R.Rows.Count = 1 Or R.Columns.Count = 1) Then
  Dim P As Range, i&
  Set P = Intersect(R, Application.Caller.Parent.UsedRange)
  If Not P Is Nothing Then
    For i = 1 To P.Count
      If P(i) = X Then
        If R.Columns.Count = 1 Then EquivPlus = i + P.Row - R.Row _
          Else EquivPlus = i + P.Column - R.Column
        Exit Function
      End If
    Next
  End If
End If
EquivPlus = [#N/A]
End Function

Function RechercheVPlus(X As Variant, R As Range) As Variant
If Not IsEmpty(X) Then
  Set R = Intersect(R, Application.Caller.Parent.UsedRange)
  If Not R Is Nothing Then
    Dim i&
    For i = 1 To R.Rows.Count
      If R(i, 1) = X Then RechercheVPlus = R(i, R.Columns.Count): Exit Function
    Next
  End If
End If
RechercheVPlus = [#N/A]
End Function

Function RechercheHPlus(X As Variant, R As Range) As Variant
If Not IsEmpty(X) Then
  Set R = Intersect(R, Application.Caller.Parent.UsedRange)
  If Not R Is Nothing Then
    Dim i%
    For i = 1 To R.Columns.Count
      If R(1, i) = X Then RechercheHPlus = R(R.Rows.Count, i): Exit Function
    Next
  End If
End If
RechercheHPlus = [#N/A]
End Function
A+
 

Pièces jointes

  • EquivPlus(1).xlsm
    24.7 KB · Affichages: 40
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Je viens de revoir les fonctions RechercheVPlus et RechercheHPlus :
Code:
Function RechercheVPlus(X As Variant, R As Range) As Variant
Dim lig As Variant
lig = EquivPlus(X, R.Columns(1))
If IsNumeric(lig) Then RechercheVPlus = R(lig, R.Columns.Count) Else RechercheVPlus = lig
End Function

Function RechercheHPlus(X As Variant, R As Range) As Variant
Dim col As Variant
col = EquivPlus(X, R.Rows(1))
If IsNumeric(col) Then RechercheHPlus = R(R.Rows.Count, col) Else RechercheHPlus = col
End Function
Maintenant elles donnent les mêmes résultats que RECHERCHEV(....;0) et RECHERCHEH(....;0).

Quel que soit le UsedRange.

Fichier (2).

A+
 

Pièces jointes

  • EquivPlus(2).xlsm
    24.5 KB · Affichages: 37

Ron2cuir

XLDnaute Nouveau
Re,

Je viens de revoir les fonctions RechercheVPlus et RechercheHPlus :
Code:
Function RechercheVPlus(X As Variant, R As Range) As Variant
Dim lig As Variant
lig = EquivPlus(X, R.Columns(1))
If IsNumeric(lig) Then RechercheVPlus = R(lig, R.Columns.Count) Else RechercheVPlus = lig
End Function

Function RechercheHPlus(X As Variant, R As Range) As Variant
Dim col As Variant
col = EquivPlus(X, R.Rows(1))
If IsNumeric(col) Then RechercheHPlus = R(R.Rows.Count, col) Else RechercheHPlus = col
End Function
Maintenant elles donnent les mêmes résultats que RECHERCHEV(....;0) et RECHERCHEH(....;0).

Quel que soit le UsedRange.

Fichier (2).

A+
 

Ron2cuir

XLDnaute Nouveau
Bonjoir (certains s'y reconnaîtront)
Voici ma version definitive (en test)

Function EquivP(Argum, Feld As Range)
Dim OkAddress, Cold, Serche
Cold = Feld.Row - 1
Set Serche = Feld.Find(Argum, LookIn:=xlValues)
If Not Serche Is Nothing Then
OkAddress = Serche.Row - 1 - Cold
If OkAddress = 0 Then EquivP = [#N/A]: GoTo Endy
End If
EquivP = OkAddress
Endy:
Set Serche = Nothing
End Function
Merci à Job75 pour les solutions proposées
Ron2Cuir (ex rama de la bande Misange, JPS, MichDenis,J@C)
 

job75

XLDnaute Barbatruc
Re,

Avec un tableau VBA EquivPlus est nettement plus rapide qu'avec toute autre méthode :
Code:
Function EquivPlus(X As Variant, R As Range) As Variant
If Not IsEmpty(X) And (R.Rows.Count = 1 Or R.Columns.Count = 1) Then
  Dim P As Range, tablo, i&
  Set P = Intersect(R, Application.Caller.Parent.UsedRange)
  If Not P Is Nothing Then
    If R.Rows.Count = 1 Then
      tablo = P.Resize(2) 'au moins 2 éléments
      For i = 1 To UBound(tablo, 2)
        If tablo(1, i) = X Then EquivPlus = i + P.Column - R.Column: Exit Function
      Next
    Else
      tablo = P
      For i = 1 To UBound(tablo)
        If tablo(i, 1) = X Then EquivPlus = i + P.Row - R.Row: Exit Function
      Next
    End If
  End If
End If
EquivPlus = [#N/A]
End Function
Fichier (3).

Bonne nuit.
 

Pièces jointes

  • EquivPlus(3).xlsm
    24.8 KB · Affichages: 44
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Ron2cuir, le forum,

Au post #1 vous parlez de 6000 lignes.

Testez le fichier joint, chez moi le recalcul des fonctions EquivPlus s'effectue en 5 minutes.

A+
 

Pièces jointes

  • Test EquivPlus 6000 lignes(1).xlsm
    258.1 KB · Affichages: 44

job75

XLDnaute Barbatruc
Re,

Effectivement il faut corriger la fonction EquivPlus pour qu'elle fonctionne :

- sur n'importe quelle feuille en remplaçant simplement Application.Caller par R

- avec les caractères génériques * et ? en remplaçant = X par Like X
Code:
Function EquivPlus(X As Variant, R As Range) As Variant

If Not IsEmpty(X) And (R.Rows.Count = 1 Or R.Columns.Count = 1) Then
  Dim P As Range, tablo, i&
  Set P = Intersect(R, R.Parent.UsedRange)
  If Not P Is Nothing Then
    If R.Rows.Count = 1 Then
      tablo = P.Resize(2) 'au moins 2 éléments
      For i = 1 To UBound(tablo, 2)
        If tablo(1, i) Like X Then EquivPlus = i + P.Column - R.Column: Exit Function
      Next
    Else
      tablo = P
      For i = 1 To UBound(tablo)
        If tablo(i, 1) Like X Then EquivPlus = i + P.Row - R.Row: Exit Function
      Next
    End If
  End If
End If
EquivPlus = [#N/A]
End Function
Fichier (4).

A+

 

Pièces jointes

  • EquivPlus(4).xlsm
    2.4 MB · Affichages: 162

job75

XLDnaute Barbatruc
Re,

Au vu de votre fichier Ron2cuir je me rends compte que votre problème se résume à déterminer si un texte x existe dans un texte y.

Et cela quel que soit le nombre de caractères de x et y.

La fonction VBA est alors très simple :
Code:
Option Compare Text 'la casse est ignorée

Function TexteExiste(x$, y$) As Boolean
TexteExiste = y Like "*" & x & "*"
End Function
On peut ensuite l'utiliser comme critère pour le filtre avancé :
Code:
Private Sub CommandButton1_Click()
If CommandButton1.Caption = "Filtrer" Then
  [E2] = "=TexteExiste(D$1,A2)" 'critère de filtrage
  [A1].CurrentRegion.AdvancedFilter xlFilterInPlace, [E1:E2]
  [E2] = ""
CommandButton1.Caption = "Afficher"
Else
  If FilterMode Then ShowAllData
  CommandButton1.Caption = "Filtrer"
End If
End Sub
Voyez le fichier joint.

Vous noterez que le filtre fonctionne bien si l'on entre en D1 la formule =A2

Bonne fin de soirée.
 

Pièces jointes

  • TexteExiste et filtre avancé(1).xlsm
    2.3 MB · Affichages: 163

Ron2cuir

XLDnaute Nouveau
Bonjour
Ce que je veux obtenir ce sont tous les numéros de ligne (limités à 300) d'une base de 6000 lignes où l'argument a été trouvé. Ces numéros servent ensuite à des intersections pour une répartion par nature d'info...avec un userform.
Merci de m'avoir fait découvrir de nouvelles fonctionnalités.
Il est vrai que l'exemple fourni ne faisait pas apparaître toute la problématique.
Salutations
 

Statistiques des forums

Discussions
294 211
Messages
1 936 900
Membres
188 102
dernier inscrit
benefaballe