[XL-2007] Recherche trop longue dans un classeur [Résolu]

[hunteshiva]

Bonjour,

j'ai adapté une macro pour qu'elle puisse fonctionner sur un classeur Excel qui fait + de 40.000 lignes,
le soucis c'est qu'il est beaucoup trop long, il met un temps fous à l'ouvrir
* + de 20 sec pour une recherche*

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
        '##################################################
        '########### Recherche de la référence ############
        '##################################################
 
        'Choix du classeur Tarif à ouvrir suivant la marque saisie
        Select Case MemMarque
 
            Case "SCH", "schneider", "Schneider", "SCHNEIDER", "Sch", "sch"
 
            '##################################################
            '############### Classeur Schneider ###############
            '##################################################
 
                'Ouverture de l'application
                Set MonExcel = CreateObject("Excel.Application")
                MonExcel.ReferenceStyle = xlR1C1
 
                'Ouverture d'un fichier Excel
                Set MonClasseur = MonExcel.Workbooks.Open("\\Server\Commandes Clients\Tarifs\Tarifs_Schneider.xls")
                'wsExcel correspond à la première feuille du fichier
                Set MaFeuille = MonClasseur.Worksheets(1)
                MonExcel.Visible = False
                MaFeuille.Activate
 
                '------------------------------------------------------------------------------------------
                '--> Recherche de la référence dans le classeur
 
                '    De la première ligne à la dernière ligne remplie
                With MaFeuille.Range("B1:B" & MaFeuille.[B65536].End(xlUp).Row)
                    Set c = .find(MemRef, LookIn:=xlValues, lookat:=xlWhole) ' "lookat:=xlWhole" permet de rechercher une valeur exacte
                    If Not c Is Nothing Then
                        Prix = .find(MemRef, LookIn:=xlValues, SearchOrder:=xlByColumns).Offset(0, 6) 'Offset(0,6) -> décale de 0 ligne et de  6 colonnes par rapport à la case qui contient la référence
                        Designation = .find(MemRef, LookIn:=xlValues, SearchOrder:=xlByColumns).Offset(0, 3)
                        Codif = .find(MemRef, LookIn:=xlValues, SearchOrder:=xlByColumns).Offset(0, 8)
                    Else
                        Prix = 0
                        Designation = "Référence Incorrecte/Non trouvée"
                        MsgBox ("Référence pour le matériel Incorrecte ou non référencée !!!")
                    End If
                End With
 
                '--> Fin de le recherche
                '------------------------------------------------------------------------------------------
 
                'Fermeture du classeur Tarif
                MonClasseur.Close savechanges:=False

Je ne sais pas si ça viens du fait qu'il est sur un serveur,
mais pour automatiser une recherche de références,
il faut que ça soit quasiment transparent.

[edelweisseric]

Bonjour hunteshiva

Je ne peux tester, n'ayant pas de serveur, mais peut être comme ceci :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub test()
 
Dim MonClasseur As Workbook
Dim mafeuille As Range
 
.........
'Choix du classeur Tarif à ouvrir suivant la marque saisie
Select Case MemMarque
 
    Case "SCH", "schneider", "Schneider", "SCHNEIDER", "Sch", "sch"  
	  Set MonClasseur = GetObject("\\Server\Commandes Clients\Tarifs\Tarifs_Schneider.xls")
	  Set mafeuille = MonClasseur.Sheets(1)
		With MaFeuille.Range("B1:B" & MaFeuille.[B65536].End(xlUp).Row)
			Set c = .find(MemRef, LookIn:=xlValues, lookat:=xlWhole)
			If Not c Is Nothing Then
				Prix = MaFeuille.range("H" & c.row)   'je ne comprends pas ton find, pour 1 MemRef tu n'as qu'1 Prix, 1 Designation et 1 Codif ?
				Designation = MaFeuille.range("E" & c.row)
				Codif = MaFeuille.range("J" & c.row)
			Else
				Prix = 0
				Designation = "Référence Incorrecte/Non trouvée"
				Codif = "Inexistant"
				MsgBox ("Référence pour le matériel Incorrecte ou non référencée !!!")
			End If
		End With		
 
	MonClasseur.Close False
......
  End Sub

si j'ai bien bien compris

Eric

[ZebreLoup]

Effectivement avec la méthode d'Edelweisseric, tu vas gagner le temps d'ouverture d'un Excel supplémentaire.

Si c'est encore trop lent, je peux te conseiller ce tutoriel

Ou encore mieux de transférer tes données dans une vraie base de données. Car Excel est un tableur et n'est pas optimal pour servir de base de données.

[hunteshiva]

ok merci,
je vais tester vos solutions dès que possible.

PS: je reviens vers vous dès que j'ai des résultats

[hunteshiva]

Salut tout le monde,

bon j'ai testé les deux solution

1. edelweisseric
   Echec cuisant
   le chargement resté aussi long,
   mais je te remercie pour l'idée
   .
2. ZebreLoup
   
   ça fonctionne très bien en requettant le fichier SQL via une connexion ODB
   je pense que ça vient du fait qu'il n'ai pas a charger le fichier en entier
   
   
   Code :

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   12
   13
   14
   15
   16
   17
   18
   19
   20
   21
   22
   23
   24
   25
   26
   27
   28
   29
   30
   31
   32
   33
   34
   35
   36
           '##################################################
           '########### Recherche de la référence ############
           '##################################################
    
           'Choix du classeur Tarif à ouvrir suivant la marque saisie
           Select Case MemMarque
    
               Case "SCH", "schneider", "Schneider", "SCHNEIDER", "Sch", "sch"
    
               '##################################################
               '############### Classeur Schneider ###############
               '##################################################
    
                   'Définit le classeur fermé servant de base de données
                   Fichier = "\\Serveur\Donnees\Commandes Clients\Tarifs\TarifBSE_2012.xls"
    
                   Set Cn = New ADODB.Connection
                   '--- Connexion ---
                   With Cn
                       .Provider = "Microsoft.Jet.OLEDB.4.0"
                       .ConnectionString = "Data Source=" & Fichier & ";Extended Properties=Excel 8.0;"
                       .Open
                   End With
    
                   'Définit la requête SQL.
                   texte_sql = "SELECT TF, Designation25, Codif FROM [TarifBSE$] WHERE RefCiale = '" & MemRef & "'"
    
                   'Connexion au fichier Excel
                   Set Rst = New ADODB.Recordset
                   'Récuperation des données
                   ' Excecution de la requete SQL
                   Set Rst = Cn.Execute(texte_sql)
                   ' Lecture des valeurs
                   Prix = Rst!TF
                   Designation = Rst!Designation25
                   Codif = Rst!Codif

C'est en beta si on peux dire,
parceque si je recois aucune valeur ou plusieur je crois que ça plante...
(des gestion d'erreurs a faire)

Mais le temps d'attente n'est plus

[hunteshiva]

Comme je suis pas chien,
voila de quoi à gérer les erreurs quand ta requête SQL ne revoie rien

Code :

1
2
3
4
5
If Not Rst.EOF And Not Rst.BOF Then
   MsgBox ("There are records.")
Else
   MsgBox ("There are no records.")
End If