Discussion :

[Master_x_99]

Bonjour à vous,

Voici un code que j'ai adapté pour effectuer une recherche sur une colonne.

Je cherche a obtenir une recherche sur 2 colonne avec le même code.

Donc recherche sur la colonne K et AA.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub Recherche()
 
    Dim valeur As Variant
    Dim premiere As Variant
    Dim liste As String
    Dim Aucun As String
    Dim Onglet As String
    Dim Cellule As Range
 
 Do
    valeur = Application.InputBox("Inscrire la donnée rechercher")
 
    'Liste est une chaine de caractères
 
    liste = "Voici ce qui vous sont attribuées :"
 
    'Aucun est une chaine de caractères
 
    Aucun = "Aucune correspondance  " & "[ " & valeur & " ]"
 
   If valeur = False Then
        Exit Sub
    End If
    If valeur = "" Then MsgBox "Vous devez entrer une donnée de recherche!", vbExclamation, "Erreur"
    Loop Until valeur <> ""
    Derlig = Range("K" & Rows.Count).End(xlUp).Row
 
        With Sheets("Résumé").Range("K27:K" & Derlig)      'Plage choisie
            Set Cellule = .Find(valeur, LookIn:=xlValues)
            If Not Cellule Is Nothing Then
                premiere = Cellule.Address
 
                Do
 
                 If Cellule.Offset(-4, -9).Value = "" Then
 
                liste = liste & vbCr & vbCr & Cellule.Offset(-4, -9) & " " & " " & Cellule.Offset(0, -2)
 
               End If
 
                 If Cellule.Offset(-4, -9).Value <> "" Then
 
                liste = liste & vbCr & vbCr & Cellule.Offset(-4, -9) & " " & " " & Cellule.Offset(-1, -2)
 
               End If
 
                    'action a faire dès que la ligne est trouvée
                    Set Cellule = .FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> premiere
 
                Else
             MsgBox Aucun, vbInformation, "Résultat"
 
              Exit Sub
            End If
       End With
 
    If Right(liste, 1) <> ":" Then MsgBox liste, vbInformation, "Résultat"
 
Application.CutCopyMode = False
 
End Sub

Merci de votre habituelle collaboration

[BENNASR]

bonjour
pour chercher dans 2 colonnes je fais avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
 Dim Test1 As Range, Test2 As Range, y As Range, F1 As Worksheet
   Set F1 = Sheets("feuil1")
   Set Test1 = Range("K2:K" & Range("K" & Rows.Count).End(xlUp).Row)
   Set Test2 = Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
   Set y = Application.Union(Test1, Test2)
   Set C = y.Find(F1.Cells(2, "L"), LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
MsgBox C.Row
End If
End Sub

j'espère que ça t'aide à avancer

[Master_x_99]

Merci BENNASR

J'ai adapté le code pour mon projet et tout fonctionne parfaitement.


Voici le résultat:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub Recherche()
 
 
    Dim valeur As Variant
    Dim premiere As Variant
    Dim liste As String
    Dim Aucun As String
    Dim Onglet As String
    Dim cellule As Range
    Dim Semaine As Range
    Dim Test1 As Range
    Dim Test2 As Range
 
 
 Do
    valeur = Application.InputBox("Inscrire  la valeur de rechercher")
 
 
    'Liste est une chaine de caractères
 
    liste = "Voici ce qui vous est attribué :"
 
 
 
    'Aucun est une chaine de caractères
 
    Aucun = "Aucune correspondance pour  " & "[ " & valeur & " ]"
 
 
 
 
   If valeur = False Then
        Exit Sub
    End If
    If valeur = "" Then MsgBox "Vous devez entrer une valeur de recherche!", vbExclamation, "Erreur"
    Loop Until valeur <> ""
 
 
 
        Set Test1 = Range("K27:K" & Range("K" & Rows.Count).End(xlUp).Row)
        Set Test2 = Range("AA27:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
 
 
 
        With Sheets("Résumé").Application.Union(Test1, Test2)
        Set cellule = .Find(valeur, LookIn:=xlValues)
        If Not cellule Is Nothing Then
            premiere = cellule.Address
 
 
 
                Do
 
 
 
                 If cellule.Offset(-5, -2).Value = "" Then
 
 
                liste = liste & vbCr & vbCr & cellule.Offset(-4, -9) & " " & " " & cellule.Offset(-1, -2)
 
               End If
 
 
                 If cellule.Offset(-5, -2).Value <> "" Then
 
                liste = liste & vbCr & vbCr & cellule.Offset(-3, -9) & " " & " " & cellule.Offset(0, -2)
 
               End If
 
 
 
                    'action a faire dès que la ligne est trouvée
                    Set cellule = .FindNext(cellule)
                Loop While Not cellule Is Nothing And cellule.Address <> premiere
 
 
                Else
             MsgBox Aucun, vbInformation, "Résultat"
 
              Exit Sub
            End If
        End With
 
    If Right(liste, 1) <> ":" Then MsgBox liste, vbInformation, "Résultat"
 
 
 
Application.CutCopyMode = False
 
 
End Sub