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
A voir également:

4 réponses

Réponse 1 / 4
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   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
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
ordi94
 
Merci de m'avoir aider a trouver une solution
0
Réponse 2 / 4
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
Réponse 3 / 4
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Ordi94 veut chercher des nombres mais :

var = InputBox("Mot à rechercher ?")

donc ?????
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention  
 
tout à fait.
Attendons le retour d'ordi94...
0
ordi94 > pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention  
 
merci pour vos efforts ce qui m'a permit de trouver une solution
0
Réponse 4 / 4
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
ordi94
 
Je vous remercier pour votre aimable collaboration
ceci m'a aidé beaucoup

merci beaucoup
0

Discussions similaires

Mot de passe administrateur Freebox : où le trouver ?
Utilisateur anonyme -
Marie -

7 réponses
recherche à partir de la barre d'adresse
Sylviane -
Lulin -

11 réponses
question pix mot caché
aorum10 -
astrid-g85 -

6 réponses