Outil recherche sur feuille Excel

Résolu
Signaler
Messages postés
2
Date d'inscription
mardi 30 octobre 2007
Statut
Membre
Dernière intervention
16 novembre 2007
-
Messages postés
2
Date d'inscription
mardi 30 octobre 2007
Statut
Membre
Dernière intervention
16 novembre 2007
-
Bonjour tout le monde.

Alors voilà, j'essaie de réaliser une base de donnée pour répertorier les entreprises avec lequelles ma société travaille.
J'ai donc créé un tableau avec 16 colonnes matérialisant les infos des entreprises (Raison sociale, SIREN, Tél, Fax, etc...).
Afin que la saisie de nouvelles entreprises soit plus facile j'ai créé un UserForm regroupant les infos à saisir dans 16 textbox. Une fois les champs renseignés les infos sont intégrées au tableau sur la première ligne vide.
Pour info voici le code (soyez pas méchant je suis vraiment débutant... j'ai mis 3 semaines avant que ça marche et encore avec un peu d'aide...)
Place au code:

Sub stock_tableau()
Dim tableau()
nb_lignes = Range("A1").End(xlDown).Row
nb_colonnes = Range("A1").End(xlToRight).Column
ReDim tableau(nb_lignes, nb_colonnes)


For lignes = 1 To nb_lignes
For colonnes = 1 To nb_colonnes
tableau(lignes, colonnes) = Cells(lignes, colonnes)
MsgBox tableau(lignes, colonnes)
Next colonnes
Next lignes
End Sub


 


Private Sub Annuler_Click()
Unload Me
End Sub


Private Sub enregistrer_Click() 'Action de validation de la boite de dialogue
  
If Me.raison_sociale.Text = "" Then 'Liste des champs obligatoires
MsgBox "Vous devez entrer une raison sociale!" 'message d'erreur si le champ est vide
        Exit Sub
End If


If Me.Siren.Text = "" Then
MsgBox "Vous devez entrer un numero SIREN!"
        Exit Sub
End If


If Me.telephone.Text = "" Then
MsgBox "Vous devez entrer un numero de telephone!"
        Exit Sub
End If
If Me.cellulaire.Text = "" Then
MsgBox "Vous devez entrer un numero de cellulaire!"
        Exit Sub
End If


If Me.fax.Text = "" Then
MsgBox "Vous devez entrer un numero fax!"
        Exit Sub
End If
If Me.contact.Text = "" Then
MsgBox "Vous devez entrer un contact!"
        Exit Sub
End If
If Me.position_contact.Text = "" Then
MsgBox "Vous devez entrer une position du contact!"
        Exit Sub
End If


If Me.adresse.Text = "" Then
MsgBox "Vous devez entrer une adresse!"
        Exit Sub
End If
If Me.code_postal.Text = "" Then
MsgBox "Vous devez entrer un code postal!"
        Exit Sub
End If


If Me.ville.Text = "" Then
MsgBox "Vous devez entrer une ville!"
        Exit Sub
End If


If Me.email.Text = "" Then
MsgBox "Vous devez entrer un e-mail!"
        Exit Sub
End If


If Me.qualibat.Text = "" Then
MsgBox "Vous devez entrer un qualibat!"
        Exit Sub
End If


If Me.specialite.Text = "" Then
MsgBox "Vous devez entrer une spécialité!"
        Exit Sub
End If


If Me.zone.Text = "" Then
MsgBox "Vous devez entrer une zone géographique!"
        Exit Sub
End If


If Me.Effectif.Text = "" Then
MsgBox "Vous devez entrer un effectif!"
        Exit Sub
End If
' Mise en place des valeurs saisies
    Range("A65536").End(xlUp).Offset(1, 0).Value = Me.raison_sociale.Text
    Range("B65536").End(xlUp).Offset(1, 0).Value = Me.Siren.Text
    Range("C65536").End(xlUp).Offset(1, 0).Value = Me.telephone.Text
    Range("D65536").End(xlUp).Offset(1, 0).Value = Me.cellulaire.Text
    Range("E65536").End(xlUp).Offset(1, 0).Value = Me.fax.Text
    Range("F65536").End(xlUp).Offset(1, 0).Value = Me.contact.Text
    Range("G65536").End(xlUp).Offset(1, 0).Value = Me.position_contact.Text
    Range("H65536").End(xlUp).Offset(1, 0).Value = Me.adresse.Text
    Range("I65536").End(xlUp).Offset(1, 0).Value = Me.complément_adresse.Text
    Range("J65536").End(xlUp).Offset(1, 0).Value = Me.code_postal.Text
    Range("K65536").End(xlUp).Offset(1, 0).Value = Me.ville.Text
    Range("L65536").End(xlUp).Offset(1, 0).Value = Me.email.Text
    Range("M65536").End(xlUp).Offset(1, 0).Value = Me.qualibat.Text
    Range("N65536").End(xlUp).Offset(1, 0).Value = Me.specialite.Text
    Range("O65536").End(xlUp).Offset(1, 0).Value = Me.zone.Text
    Range("P65536").End(xlUp).Offset(1, 0).Value = Me.Effectif.Text
       
Unload Me
End Sub

Donc, cet UserForm fonctionne.

C'est concernant le deuxième UserForm que ça coince. Je m'explique:
J'ai mis en place un bouton "Rechercher" dans Excel.
L'action voulue est de pouvoir rechercher les informations d'une entreprise dans le tableau avec soit le nom de l'entreprise, son numéro SIREN, un corp d'état (via un ComboBox) ou un secteur géographique (via un ComboBox), avec la possibilité de renseigner un ou plusieur de ces champs.

J'ai donc fais un bidouillage qui fonctionne avec la recherche par nom uniquement et qui ne me donne qu'une seule information (selection d'une seule colonne possible).

Voici le code:

Private Sub Annuler_Click()
Unload Me
End Sub


Private Sub cmdok_Click()


'Déclaration des variables utilisées
Dim ligne As Long
Dim valeursaisie As String
Dim valeurcherchée As String
Dim Message As Byte


'Boucle permettant de chercher la valeur saisie
For ligne = 2 To Sheets("Liste").Range("A1").End(xlDown).Row
   valeursaisie = Sheets("Liste").Range("A" & ligne).Value
               valeurcherchée = Sheets("Liste").Range(("C") & ligne).Value
               If Nom.Value = valeursaisie Then
               valeursaisie = ActiveCell
            Message = MsgBox("Coordonnées du sous traitant recherché " & valeurcherchée, vbOKOnly, "Valeur cherchée")
            End If
        Next ligne
End Sub

C'est en fait un code trouvé sur le net et légerement adapté.
ça fait une semaine que je rame pour trouver comment faire pour que cette recherche fonctionne.

Auriez-vous un ou deux conseils pour que je puisse faire avancer ce shmilblick??

Merci d'avance pour votre aide!

2 réponses

Messages postés
2
Date d'inscription
mardi 30 octobre 2007
Statut
Membre
Dernière intervention
16 novembre 2007

Bonjour tt le monde.

Je viens de résoudre la problème.
Voici le code:

Private Sub CommandButton1_Click()
'Déclaration des variables utilisées
Dim ligne As Long
Dim valeursaisie As String
Dim raison_sociale As String
Dim téléphone As String
Dim cellulaire As String
Dim fax As String
Dim contact As String
Dim positioncontact As String
Dim adresse As String
Dim complément As String
Dim cp As String
Dim ville As String
Dim mail As String
Dim qualibat As String
Dim spécialité As String
Dim secteur_géo As String
Dim Effectif As String


Dim Message As Byte


'Boucle permettant de chercher la valeur saisie
For ligne = 2 To Sheets("Liste").Range("A1").End(xlDown).Row
   valeursaisie = Sheets("Liste").Range("O" & ligne).Value
               raison_sociale = Sheets("Liste").Range("A" & ligne).Value
               téléphone = Sheets("Liste").Range("C" & ligne).Value
               cellulaire = Sheets("Liste").Range("D" & ligne).Value
               fax = Sheets("Liste").Range("E" & ligne).Value
               contact = Sheets("Liste").Range("F" & ligne).Value
               positioncontact = Sheets("Liste").Range("G" & ligne).Value
               adresse = Sheets("Liste").Range("H" & ligne).Value
               complément = Sheets("Liste").Range("I" & ligne).Value
               cp = Sheets("Liste").Range("J" & ligne).Value
               ville = Sheets("Liste").Range("K" & ligne).Value
               mail = Sheets("Liste").Range("L" & ligne).Value
               qualibat = Sheets("Liste").Range("M" & ligne).Value
               spécialité = Sheets("Liste").Range("N" & ligne).Value
               secteur_géo = Sheets("Liste").Range("O" & ligne).Value
               Effectif = Sheets("Liste").Range("P" & ligne).Value
              
               If ComboBox1.Value = valeursaisie Then
               valeursaisie = ActiveCell
                          
            Message = MsgBox("Entreprises correspondant à votre recherche: " & vbCrLf & vbCrLf & "Raison sociale: " & raison_sociale & vbCrLf & "Contact: " & contact & ", " & positioncontact & vbCrLf & vbCrLf & "Tel: " & téléphone & vbCrLf & "Cellulaire: " & cellulaire & vbCrLf & "Fax: " & fax & vbCrLf & vbCrLf & "Adresse: " & adresse & vbCrLf & "Complément: " & complément & vbCrLf & "Code postal: " & cp & "- " & ville & vbCrLf & vbCrLf & "Adresse e-mail: " & mail & vbCrLf & "Qualibat: " & qualibat & vbCrLf & "Spécialité: " & spécialité & vbCrLf & "Effectif: " & Effectif & vbCrLf & "Secteur géographique: " & secteur_géo, vbOKOnly, "Valeur cherchée")
            End If
        Next ligne
End Sub


Bon, ça rique de faire grincer des dents les puristes mais ça marche...... & à mon niveau c'est déjà un miracle !

Merci à Brosske pour son aide précieuse !


Bonne journée à toutes & à tous et bon week end


Acheteur tentant de programmer...
Messages postés
98
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
12 août 2010
1
Bonjour,


Je peux t'aider,envoi moi un mp stp si ce n'est pas trop tard.


J'ai développé une petite appi en VBA qui permets de mettre en surbrillance un critère de recherche d'une feuille excel. Reste encore à le modifier pour qu'il prenne en charge le reste (mais ça sera du gâteau)


Le tout est parfaitmenent réalisable en combinaison avec VB6.

F.M.