Dim var as long

ordi94 -  
 ordi94 -
Bonjour,



merci de m'aider a resoudre ce probleme

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

Sub test()
    With Worksheets("feuil1")
        var = InputBox("Mot à rechercher ?")
        For Each Cell In .Range("A1").End(xlDown)
            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 For
            End If
        Next Cell
        MsgBox "Pas trouvé!!!!!!!"
    End With
End Sub


EDIT: Ajout de la coloration syntaxique.
A voir également:

2 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Sub test()
    Dim var As Long
    
    With Worksheets("feuil1")
        var = InputBox("Mot à rechercher ?")
        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
0
ordi94
 
merci pour avoir m'aider pour résoudre ce problème

Merci beaucoup
0