VBA, vérifier existence valeur Résolu

Question

Bonjour, 

je bloque légèrement
j'ai un fichier "moteur de recherche" qui contient un userform.
on tape notre recherche à travers une textbox et une combobox
on lance la recherche, ça ouvre un fichier en lecture seule et le but est de se placer sur la bonne feuille de ce second fichier

en A1 et A2 de chaque feuille on a une valeur qui correspond à la concaténation de la textbox et de la combobox
voici le code actuel :

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'teste si un numéro a été entré, si non, le programme averti l'utilisateur et s'arrête
If UserForm1.TextBox1.Text = "" Then
    MsgBox "Aucun PN n'a été saisi !"
    Exit Sub
End If
                   
If Len(UserForm1.TextBox1.Text) <> 8 Then
    MsgBox "le Part Number est incorrect !!!"
    Exit Sub
End If

monfichier = "X:\QEHS\QA_DOC_FE\QA_FOURNISSEURS\0_CHEMICALS_RESISTS\2011\Risques excursion Qa\graphes.xlsm"
Application.Workbooks.Open Filename:=monfichier, ReadOnly:=True
                   
'chercher la feuille du fournisseur correspondant
Dim feuille As String
Dim shFo As Worksheet

feuille = TextBox1 & " " & ComboBox1
            For Each shFo In Worksheets
                Set a = shFo.Range("A1:A2").Find(feuille, lookat:=xlWhole)
                If Not a Is Nothing Then
                    Worksheets(shFo.Name).Activate
                    UserForm1.Hide
                    Exit For
            Next
End If             
Application.ScreenUpdating = True
End Sub

ça fonctionne, par contre ça nécessite quelques secondes, y a-t-il moyen d'accélérer le code ?
et mon soucis c'est que si la feuille avec les valeurs en A1 et A2 n'existe pas alors le programme me place sur la feuille active par défaut !!! j'aimerais que si la feuille n'est pas présente alors un message informe l'utilisateur sinon il va penser qu'il est sur la bonne feuille...

merci à vous
Configuration: Windows XP / Internet Explorer 7.0

pijaku · Answer

Bonjour,
Pour accélerer le processus, je ne sais pas, mais je ne pense pas que l'on puisse faire plus rapide...

!!!!! A la place du End If par rapport au Next !!!

Par contre, pour le message à l'utilisateur, c'est beaucoup plus facile.
Tu dis dans ton code :
Si tu trouves la bonne feuille alors
tu la sélectionnes
et tu sors de la boucle et pis c'est tout
Il te suffit donc de placer un message après la boucle et de remplacer ton Exit For par un Exit Sub. Comme ça s'il ne sort pas de la procédure c'est qu'il n'a pas trouvé tes valeurs...
If Not a Is Nothing Then 
    Worksheets(shFo.Name).Activate 
    UserForm1.Hide
    Application.ScreenUpdating = True
    'Exit For
    Exit Sub 
End If
Next
MsgBox "Références non trouvées dans les feuilles du classeur"
Application.ScreenUpdating = True 
End Sub

Patrice33740 · Answer

bonjour,

Au lieu de : 

For Each shFo In Worksheets
Set a = shFo.Range("A1:A2").Find(feuille, lookat:=xlWhole)
If Not a Is Nothing Then
Worksheets(shFo.Name).Activate
UserForm1.Hide
Exit For
Next
End If 

Essayer :
For Each shFo In Worksheets
  If shFo.Range("A1").Formula = feuille Or shFo.Range("A2").Formula = feuille Then
    shFo.Activate
    UserForm1.Hide
    Exit For
  Else
   ActiveWorkbook.Saved = True
   ActiveWorkbook.Close
   MsgBox "Non trouvé"
  End If
Next

michel_m · Answer

Bonjour

peut-^tre plus rapide mais pas sûr ( à essayer)

Sub peutetreplusvite()
Dim shFo As Worksheet, monfichier as string
Dim D_onglet As Object

monfichier = "X:\QEHS\QA_DOC_FE\QA_FOURNISSEURS\0_CHEMICALS_RESISTS\2011\Risques excursion Qa\graphes.xlsm"
'monfichier = "D:\documents\av-Evaluate-v3.xls"
'Application.Workbooks.Open Filename:=monfichier, ReadOnly:=True
feuille = TextBox1 & " " & ComboBox1
'feuille = "Moyenne"

Set D_onglet = CreateObject("scripting.dictionary")
For Each shFo In Worksheets
     onglet = shFo.Name
     D_onglet.Add shFo.Name, shFo.Name
Next

If D_onglet.exists(feuille) Then
     Sheets(feuille).Activate
     '..... suite ton code
 Else
     GoTo erreur
  End If

Exit Sub

erreur:
MsgBox feuille & "n'existe pas dans ce classeur", vbCritical
   ActiveWorkbook.Saved = True
   ActiveWorkbook.Close
End Sub

VBA, vérifier existence valeur

3 réponses

Discussions similaires

Newsletters