Var = InputBox("Mot à rechercher ?")

Résolu/Fermé
ordi94 - Modifié par pijaku le 23/01/2015 à 07:50
 ordi94 - 23 janv. 2015 à 18:58
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

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
22 janv. 2015 à 19:27
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
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
Merci de m'avoir aider a trouver une solution
0
f894009 Messages postés 17237 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 5 février 2025 1 712
Modifié par f894009 le 23/01/2015 à 07:35
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 753
Modifié par pijaku le 23/01/2015 à 08:15
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 17237 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 5 février 2025 1 712
Modifié par f894009 le 23/01/2015 à 08:00
Bonjour,

Ordi94 veut chercher des nombres mais :

var = InputBox("Mot à rechercher ?")

donc ?????
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 753 > f894009 Messages postés 17237 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 5 février 2025
23 janv. 2015 à 08:16
tout à fait.
Attendons le retour d'ordi94...
0
ordi94 > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
23 janv. 2015 à 18:58
merci pour vos efforts ce qui m'a permit de trouver une solution
0
f894009 Messages postés 17237 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 5 février 2025 1 712
Modifié par f894009 le 23/01/2015 à 08:37
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
Je vous remercier pour votre aimable collaboration
ceci m'a aidé beaucoup

merci beaucoup
0