Var = InputBox("Mot à rechercher ?")

Résolu
ordi94 -  
 ordi94 -
help me si quelque peut voir ce probleme
merci
..................................................
apres avoir lancer la macro
inputBox apparait si j'intoduit aucune valeur
ou des lettres
le script de la macro apparait
a cette ligne en couleur jaune
var = InputBox("Mot à rechercher ?")
car Dim var as long
je souhaite si j intoduis autre que le chiffre
un message apparait
MsgBox "Pas trouvé!!!!!!!"
/////////////////////////////////////////////////////////// 

Sub test()
    Dim var As Long
    
    With Worksheets("feuil1")
      var = InputBox("Mot à rechercher ?") '******ICI
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For Each Cell In .Range("A1:A" & derlig)
            If Cell = var Then
                If Cell.Offset(0, 1) = "homme" Then
                    txt1 = "Nom du jeune homme"
                    txt2 = "Prenom du jeune homme"
                ElseIf Cell.Offset(0, 1) = "femme" Then
                    txt1 = "Nom de la jeune femme"
                    txt2 = "Prenom de la jeune femme"
                Else
                    MsgBox "Civilite inconnue !!!!"
                    Exit Sub
                End If
                derlig = Worksheets("feuil2").Range("A" & Rows.Count).End(xlUp).Row
                If derlig > 1 Then
                    derlig = derlig + 1
                End If
                Worksheets("feuil2").Cells(derlig, 1) = txt1
                Worksheets("feuil2").Cells(derlig, 3) = "age"
                Cell.Offset(0, 2).Copy Worksheets("feuil2").Cells(derlig, 2)
                Cell.Offset(0, 4).Copy Worksheets("feuil2").Cells(derlig, 4)
                Worksheets("feuil2").Cells(derlig + 1, 1) = txt2
                Worksheets("feuil2").Cells(derlig + 1, 3) = "ville"
                Cell.Offset(0, 3).Copy Worksheets("feuil2").Cells(derlig + 1, 2)
                Cell.Offset(0, 5).Copy Worksheets("feuil2").Cells(derlig + 1, 4)
                Exit Sub
            End If
        Next Cell
        MsgBox "Pas trouvé!!!!!!!"
    End With
End Sub

4 réponses

  1.
    ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonsoir Ordi, bonsoir le forum,

    Pourquoi une boucle si tu dois t'arrêter à la première occurrence trouvée ? Je te propose une autre solution avec la fonction Find : 

    Sub Macro1()
Dim O1 As Worksheet 'déclare la variable O1 (Onglet 1)
Dim O2 As Worksheet 'déclare la variable O2 (Onglet 2)
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim R As Range 'déclare la variable R (Recherche)
Dim T1 As String 'déclare la variable T1 (Texte 1)
Dim T2 As String 'déclare la variable T2 (Texte 2)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set O1 = Sheets("Feuil1") 'définit l'onglet O1
Set O2 = Sheets("Feuil2") 'définit l'onglet O2
BE = Application.InputBox("Mot à rechercher ?", Type:=3) 'définit la boîte d'entrée BE
If BE = False Or BE = "" Then Exit Sub 'si bouton [Annuler] ou si valeur non renseignée, sort de la procédure
'définit la recherche R (recherche la valeur entière de BE dans la colonne 1 (=A) de l'onglet O1)
Set R = O1.Columns(1).Find(BE, , xlValues, xlWhole)
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    Select Case R.Offset(0, 1).Value 'agit en fonction de la valeur la cellule à droite de l'occurrence trouvée
        Case "homme" 'cas "Homme"
            T1 = "Nom du jeune homme" 'définit le texte T1
            T2 = "Prénom du jeune homme" 'définit le texte T2
        Case "femme" 'cas "femme"
            T1 = "Nom de la jeune femme" 'définit le texte T1
            T2 = "Prénom de la jeune femme" 'définit le texte T2
        Case Else 'autre cas
            MsgBox "Civilité inconnue !" 'message
            Exit Sub 'sort de la procédure
    End Select 'fin de l'action en fonction de ...
    'définit la ligne LI (1 si A1 est vide, sinon la première celllule vide de la colonne 1 (=A) de l'onglet O2)
    LI = IIf(O2.Range("A1") = "", 1, O2.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1)
    'récupération des données
    O2.Cells(DL, 1) = T1
    O2.Cells(DL, 2) = R.Offset(0, 2).Value
    O2.Cells(DL, 3) = "age"
    O2.Cells(DL, 4) = R.Offset(0, 4).Value
    O2.Cells(DL + 1, 1).Value = T2
    O2.Cells(DL + 1, 2).Value = R.Offset(0, 3).Value
    O2.Cells(DL + 1, 3).Value = "ville"
    O2.Cells(DL + 1, 4).Value = R.Offset(0, 5).Value
Else 'sinon (si il n'existe aucune occurrence)
    MsgBox Chr(34) & BE & Chr(34) & " n'a pas été trouvé !" 'message
End If 'fin de la condition
End Sub

    0
    1. ordi94
       
      voila un tabkeau
      si la variable var =contient 6 chiffres exemple 200000 la macro ne fonction pas
      Dim var As Long
      'A1 B1 C1 D1
      'nom du jeune homme... toto.... age.... 22
      'A2 B2 C2 D2
      'prenom jeune homme... paul..... ville... paris
      ............................................................................
      voici un tableau parlant:
      ............................................................................
      A1:A10... civilite .......nom ....prenom ...age ...ville
      100000 .... homme....... toto.... paul.......22.... paris
      200000 ...... femme........ fifi... catherine ...33.... marseille
      .....................................................................
      300....... homme .......papy.....jean...... 77...... lyon
      400...... femme........ mimi.....severine..88...... bordeaux
      .....................................................................
      resultat sur la feuille2:apres avoir lancer la macro
      ...................................................................
      nom du jeune homme... toto.... age.... 22
      prenom jeune homme... paul..... ville... paris
      ...................................................................
      nom du jeune fille........ fifi..... age..... 33
      prenom du jeune..... catherine... ville ...marseille

      j'ai la macro mais ca fonctionne pas
      0
    2. ordi94
       
      Merci de m'avoir aider a trouver une solution
      0
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour, 

    var = InputBox("Mot à rechercher ?")


    pour eviter l'erreur sur saisie autre que chiffre, la croix rouge ou rien:

    remplacez
    Dim var As Long

    par
    Dim var

    var prendra le type de ce que vous aurez saisie ou pas
    0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    A vous de savoir, au préalable, le type de données que vous allez chercher.

    S'il s'agit de :
    1- un nombre => utilisez Application.InputBox("Texte", "Titre", Type:=1)

    2- un String : utilisez InputBox avec une variable de type String

    3- n'importe quel type => utilisez la méthode de f894009 avec un variant

    Ensuite, je vous recommande ces lectures
    pour www.commentcamarche.net/faq/41585-vba-inputbox
    et pour la méthode find.

    🎼 Cordialement,
    Franck 🎶
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Ordi94 veut chercher des nombres mais :

      var = InputBox("Mot à rechercher ?")

      donc ?????
      0
      1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
         
        tout à fait.
        Attendons le retour d'ordi94...
        0
      2. ordi94 > pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention  
         
        merci pour vos efforts ce qui m'a permit de trouver une solution
        0
  4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    a 07:33 ai ecrit une betise, suffit pas de changer la declaration si saisie alpha.

    avec le code de depart: 

    Sub test()
    Dim var
    
    With Worksheets("feuil1")
      var = InputBox("Mot à rechercher ?") '******ICI
      
      If IsNumeric(var) Then
        var = CLng(var)
      End If
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For Each Cell In .Range("A1:A" & derlig)
            If Cell = var Then
                If Cell.Offset(0, 1) = "homme" Then
                    txt1 = "Nom du jeune homme"
                    txt2 = "Prenom du jeune homme"
                ElseIf Cell.Offset(0, 1) = "femme" Then
                    txt1 = "Nom de la jeune femme"
                    txt2 = "Prenom de la jeune femme"
                Else
                    MsgBox "Civilite inconnue !!!!"
                    Exit Sub
                End If
                derlig = Worksheets("feuil2").Range("A" & Rows.Count).End(xlUp).Row
                If derlig > 1 Then
                    derlig = derlig + 1
                End If
                Worksheets("feuil2").Cells(derlig, 1) = txt1
                Worksheets("feuil2").Cells(derlig, 3) = "age"
                Cell.Offset(0, 2).Copy Worksheets("feuil2").Cells(derlig, 2)
                Cell.Offset(0, 4).Copy Worksheets("feuil2").Cells(derlig, 4)
                Worksheets("feuil2").Cells(derlig + 1, 1) = txt2
                Worksheets("feuil2").Cells(derlig + 1, 3) = "ville"
                Cell.Offset(0, 3).Copy Worksheets("feuil2").Cells(derlig + 1, 2)
                Cell.Offset(0, 5).Copy Worksheets("feuil2").Cells(derlig + 1, 4)
                Exit Sub
            End If
        Next Cell
        MsgBox "Pas trouvé!!!!!!!"
    End With
End Sub


    avec find: 

    Sub test_Find()
    Dim var
    
    With Worksheets("feuil1")
      var = InputBox("Mot à rechercher ?") '******ICI
      
      If IsNumeric(var) Then
        var = CLng(var)
      End If
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set Plage = .Range("A1:A" & derlig)
        Nb = Application.CountIf(Plage, var)
        If Nb = 1 Then
            lig = 1
            lig = .Columns("A").Find(var, .Cells(lig, "A"), , xlWhole).Row
            If .Cells(lig, 2) = "homme" Then
                txt1 = "Nom du jeune homme"
                txt2 = "Prenom du jeune homme"
            ElseIf .Cells(lig, 2) = "femme" Then
                txt1 = "Nom de la jeune femme"
                txt2 = "Prenom de la jeune femme"
            Else
                MsgBox "Civilite inconnue !!!!"
                Exit Sub
            End If
            derlig = Worksheets("feuil2").Range("A" & Rows.Count).End(xlUp).Row
            If derlig > 1 Then
                derlig = derlig + 1
            End If
            Worksheets("feuil2").Cells(derlig, 1) = txt1
            Worksheets("feuil2").Cells(derlig, 3) = "age"
            .Cells(lig, 3).Copy Worksheets("feuil2").Cells(derlig, 2)
            .Cells(lig, 5).Copy Worksheets("feuil2").Cells(derlig, 4)
            Worksheets("feuil2").Cells(derlig + 1, 1) = txt2
            Worksheets("feuil2").Cells(derlig + 1, 3) = "ville"
            .Cells(lig, 4).Copy Worksheets("feuil2").Cells(derlig + 1, 2)
            .Cells(lig, 6).Copy Worksheets("feuil2").Cells(derlig + 1, 4)
        ElseIf Nb > 1 Then
            MsgBox "Attention " & Nb & " fois la meme reference !!!!!"
        Else
            MsgBox "Pas trouvé!!!!!!!"
        End If
    End With
End Sub
    0
    1. ordi94
       
      Je vous remercier pour votre aimable collaboration
      ceci m'a aidé beaucoup

      merci beaucoup
      0

Discussions similaires

question pix mot caché
aorum10 -
pixlagalere -

7 réponses
Mot de passe administrateur Freebox : où le trouver ?
Utilisateur anonyme -
Marie -

7 réponses
RETROUVER VENDEUR Sur le bon coin
PTM_026 -
Didi64_549 -

4 réponses
Le bon coin, comment retrouver un pseudonyme ?
HYPERSENSIBLE -
Robin -

8 réponses