Recherche multiple dans Excel

Recherche multiple dans Excel - VB/VBA/VBS - Programmation

Marsh Posté le 18-10-2006 à 01:31:05    

Bonjour,
 
Je cherche à réaliser une recherche multi-critères dans un tableau Excel. Je m'explique : D'un côté, j'ai un tableau contenant certaines valeurs. De l'autre, j'ai un tableau contenant les mêmes données, mais dans des colonnes différentes, et dans un ordre différent.
Par exemple, je vais avoir :
Tableau 1 :  
x1,x2,x3
y1,y2,y3
z1,z2,z3
 
Tableau 2 :
y2,y3,y1
x2,x3,x1
z2,z3,z1
 
Je souhaite vérifier pour chaque ligne du Tableau 1 qu'une correspondance existe dans le Tableau 2, en lui donnant la correspondance des colonnes (dans mon exemple, 1<->2, 2<->3 et 3<->1)
 
J'ai déjà fait un truc, dont le principe est le suivant :
 
Pour chaque ligne du Tableau 1
Pour le nombre de colonnes représentatives, je vais faire une sélection progressive : D'abord, je construis une liste contenant les lignes où le premier critère correspond.
Puis je parcours cette liste, et pour chaque ligne, je vérifie le second critère, ce qui me donne une nouvelle liste plus sélective
etc... autant de fois qu'il y a de critères.
 
Le code (ici, j'ai juste "simulé" le nombre de critères, mais la correspondance entre les colonnes est facile à implémenter) :  

Code :
  1. Option Explicit
  2. Sub Test()
  3. Application.ScreenUpdating = False
  4. Dim Time1 As Variant
  5. Dim Time2 As Variant
  6. Dim i As Integer
  7. Dim j As Variant
  8. Dim k As Integer
  9. Dim l As Integer
  10. Dim NbCriteria As Integer
  11. Dim SelectionListVirgin()
  12. Dim SelectionList()
  13. Dim SelectionListTempo()
  14. Time1 = Time
  15. i = 1
  16. While Sheets("All" ).Cells(i, 1) <> ""
  17.     ReDim Preserve SelectionListVirgin(1 To i)
  18.     SelectionListVirgin(i) = i
  19.     i = i + 1
  20. Wend
  21. For l = 1 To Sheets("Feuil1" ).UsedRange.Rows.Count
  22.     SelectionList = SelectionListVirgin
  23.     NbCriteria = 4
  24.     For i = 1 To NbCriteria
  25.         k = 1
  26.         For Each j In SelectionList
  27.             If Sheets("All" ).Cells(j, i) = Sheets("Feuil1" ).Cells(l, i) Then
  28.                     ReDim Preserve SelectionListTempo(1 To k)
  29.                     SelectionListTempo(k) = j
  30.                     k = k + 1
  31.             End If
  32.         Next
  33.         SelectionList = SelectionListTempo
  34.         ReDim SelectionListTempo(1 To 1)
  35.         SelectionListTempo(1) = "NULL"
  36.     Next
  37.     Sheets("Feuil1" ).Cells(l, 5) = SelectionList
  38. Next
  39. Time2 = Time
  40. Application.ScreenUpdating = True
  41. Sheets("Feuil1" ).Cells(1, 6) = Time2 - Time1
  42. End Sub


 
Dans les faits, ça marche. Le problème, c'est que pour 4 critères, pour matcher 100 lignes parmi 30,000, ça prend un peu plus de 3 minutes. Or le truc, c'est qu'il va falloir que mon affaire soit capable de gérer un matching de jusqu'à 20 critères, pour matcher 50,000 entrées parmis 50,000 (ordres de grandeurs)
Vous imaginez aisément l'explosion du temps de traitement...
 
Idéalement, une évolution du vlookup pour pouvoir matcher plusieurs critères serait idéale, mais je n'ai pas connaissance de l'existence d'une telle fonction...
 
Voilà voilà, si quelqu'un a une idée, ça pourrait m'être diablement utile :)
 
Merci beaucoup !


---------------
"Mon modèle, c'est moi-même."
Reply

Marsh Posté le 18-10-2006 à 01:31:05   

Reply

Marsh Posté le 18-10-2006 à 04:58:25    

Bonjour,
Comme ça à la hache et sans rien tester...
au lieu de la 1ère boucle While :
Détecte la dernière ligne avec une formule du type
i = Cells(65535, 1).End(xlUp).Row
et charge ton Array avec une formule du type
SelectionListVirgin() = Range(Cells(1,1),Cells(i,1))
... Mais utilise de préférence un tableau multicolonne !
SelectionListVirgin() = Range(Cells(1,1),Cells(i,20))
 
c'est idiot de charger des array pour travailler ensuite au ligne par ligne sur tes feuilles Excel
au pire si des array de 50000 x 20 ça ne passe pas saucissonne le travail en 10 array de 5000 lignes... mais je ne suis pas certain que ce soit indispensable.
 
Au lieu de dupliquer cet Array tu fais la même chose avec Feuil1
ensuite compare les array entre eux
 
2ème boucle :
For l = 1 To Sheets("Feuil1" ).UsedRange.Rows.Count    
 
Next
 
je comprend : faire 50000 fois le même travail ! C'est sur que ça doit calmer...
à supprimer. (ou à revoir)
 
3ème boucle :
 
For i = 1 To NbCriteria  
s'il y a 20 critères ça fait 20 x 50000 (j)
 
Personnellement je commencerai directement la boucle suivante :
 
For j = 1 to Ubound SelectionList
et je glisserai la boucle nombre de critère dedans avec un Exit For quand un des critères est faux : c'est toujours ça de gagné...
 
Au lieu de charger un troisième array modifie directement SelectionList parce que les Redim ç'est un peu brouette...
 
au pifomètre ça doit passer en moins d'une minute même avec un tableau de 20 x 50000 (ça dépend surtout du nombre d'égalités strictes)
 
Si j'ai le temps j'essaierai de développer ça dans la journée...
A+


Message édité par galopin01 le 18-10-2006 à 04:59:39
Reply

Marsh Posté le 18-10-2006 à 12:22:54    

Il me balance du "type Mismatched" avec le code suivant :
 
Dim i As Integer
Dim k As Integer
Dim Selection1()
Dim Selection2()
 
i = Sheets("File 1" ).Cells(65535, 1).End(xlUp).Row
Sheets("File 1" ).Select
k = ActiveCell.SpecialCells(xlLastCell).Column
ReDim Selection1(1 To i, 1 To k)
Selection1() = Sheets("File 1" ).Range(Cells(1, 1), Cells(i, k))

Reply

Marsh Posté le 18-10-2006 à 12:23:56    

Ouais c'est bon, j'ai inversé lignes / colonnes je pense.

Reply

Marsh Posté le 18-10-2006 à 12:24:35    

Ben non en fait

Reply

Marsh Posté le 18-10-2006 à 13:27:09    

bonjour,
Je t'avais bien dit que je l'ai fait à la hache !
En fait pour charger ton array de cette manière, tu n'as pas besoin de redim mais tu dois absolument travailler sur la FeuilleActive (pas une instance, pas de with...)
 
Dim i As Integer  
Dim k As Integer  
Dim Selection1()  
Dim Selection2()  
Sheets("File 1" ).Activate
i = Cells(65535, 1).End(xlUp).Row  
Sheets("File 1" ).Select  
k = ActiveCell.SpecialCells(xlLastCell).Column  
Selection1() = Range(Cells(1, 1), Cells(i, k))
 
A+

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed