Discussion :

[Leodams]

Bonjour,

Je cherche une solution avec une formule ou macro pour effectuer des recherches dans une base donnée Excel.
- la colonne A est ma référence qui me permet de faire des vlookup.

S'il trouve l'information avec la condition X dans le mot il reporte vers la colonne B
S'il trouve l'information avec la condition Y dans le mot il reporte vers la colonne C
S'il ne trouve pas mettre "non publié" dans les colonnes X et Y

La commande Vlookup est limitée dans ce cas car elle s'arrêtera dés qu'elle aura trouver la première concordance;

J'espère que je suis clair dans mon explication.

Voilà ce que j'ai fait mais je ne parviens pas mettre la condition

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
 
Sub SuiviPortail()
 
Dim cell As Range
Dim WsSrc As Worksheet
Dim WsDest As Worksheet
Dim b As Range
 
Set WsSrc = Sheets("All Apps")
Set WsDest = Sheets("wsReport")
 
For Each cell In WsDest.Range("a1:a" & WsDest.Range("b" & Rows.Count).End(xlUp).Row)
    Set b = WsSrc.Range("b:b").Find(cell, LookIn:=xlValues, LookAt:=xlPart)
 
    If Not b Is Nothing Then
        With WsDest
            .Cells(cell.Row, 8) = WsSrc.Cells(cell.Row, 3)
    End With
    End If
Next cell
 
End Sub

Sauf qu'il me renvoi la même valeur... Je sèche.

Merci de votre aide

Merci de votre aide

[Theze]

Bonjour,

De cette façon peut être ?

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
 
Private Sub ComboBox1_Click()
 
    Dim WsSrc As Worksheet
    Dim WsDest As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim CelTrouve As Range
    Dim Adr As String
 
    Set WsSrc = Sheets("All Apps")
    Set WsDest = Sheets("wsReport")
 
    With Worksheets("wsReport")
 
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    For Each Cel In Plage
 
        Set CelTrouve = Plage.Find(Cel.Value, , xlValues, xlPart)
 
        If Not CelTrouve Is Nothing Then
 
            Adr = CelTrouve.Address
 
            Do
 
                WsDest.Cells(Cel.Row, 8) = WsSrc.Cells(Cel.Row, 3)
 
                Set CelTrouve = Plage.FindNext(CelTrouve)
 
            Loop While Adr <> CelTrouve.Address
 
        End If
 
    Next Cel
 
End Sub

Hervé.