Discussion :

[BERRACHED SAID]

Bonjour le forum

j'ai met un code pour effectuer une recherche sur M2:Q d'une feuille alors que j'ai bien spécifier le range alors il continue a me renvoyer dans listbox le continue du range A2:E j'ai pas compris si quelqu'un a une idée merci d'avance.

voici le code :

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
Private Sub ListBox1_Change()
On Error Resume Next
    Dim Sh As Worksheet
    Dim rng As Range
    Dim r As Integer
    Dim Cell As Range
    Dim FirstAddr As String
    Dim LR As Integer
 
 
    Set Sh = Worksheets("bdCarr")
 
    LR = Sh.Range("M65536").End(xlUp).Row + 1 'Sh.Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Sh.Range("M2:Q" & LR)
    r = 0
    Feuil1.ListBox3.Clear
    With rng
        Set Cell = .Find(What:=Feuil1.ListBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cell Is Nothing Then
            FirstAddr = Cell.Address
            Do
                With Feuil1.ListBox3
                    .AddItem Cell.EntireRow.Cells(1, 1).Value
                    .List(r, 1) = Cell.EntireRow.Cells(1, 2).Value
                    .List(r, 2) = Cell.EntireRow.Cells(1, 3).Value
                    .List(r, 3) = Cell.EntireRow.Cells(1, 4).Value
                    .List(r, 4) = Cell.EntireRow.Cells(1, 5).Value
                    r = r + 1
                End With
            Set Cell = .FindNext(Cell)
            Loop While Not Cell Is Nothing And Cell.Address <> FirstAddr
        End If
    End With
End Sub

Bonne journée

[Theze]

Bonjour,

C'est normal, puisque c'est ce que tu demande !

Code :

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

1
2
3
4
5
6
7
8
9
 
With Feuil1.ListBox3
    .AddItem Cell.EntireRow.Cells(1, 1).Value '1 --> colonne A
    .List(r, 1) = Cell.EntireRow.Cells(1, 2).Value '2 --> colonne B
    .List(r, 2) = Cell.EntireRow.Cells(1, 3).Value '3 --> etc...
    .List(r, 3) = Cell.EntireRow.Cells(1, 4).Value
    .List(r, 4) = Cell.EntireRow.Cells(1, 5).Value
    r = r + 1
End With

donc :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
With Feuil1.ListBox3
 
    .AddItem .Cells(1, 13).Value '13 --> colonne M
    .List(r, 1) = .Cells(1, 14).Value '14 --> colonne N
    .List(r, 2) = .Cells(1, 15).Value '15 --> etc...
    .List(r, 3) = .Cells(1, 16).Value
    .List(r, 4) = .Cells(1, 17).Value
    r = r + 1
 
End With

Hervé.

Rectificatif :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
With Feuil1.ListBox3
 
    .AddItem Cell.Cells(1, 13).Value '13 --> colonne M
    .List(r, 1) = Cell.Cells(1, 14).Value '14 --> colonne N
    .List(r, 2) = Cell.Cells(1, 15).Value '15 --> etc...
    .List(r, 3) = Cell.Cells(1, 16).Value
    .List(r, 4) = Cell.Cells(1, 17).Value
    r = r + 1
 
End With

Hervé.

[BERRACHED SAID]

Merci Theze

j'ai pris note de vos modification mais désormais il m'affiche rien sur le listbox

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
Private Sub ListBox1_Change()
'On Error Resume Next
    Dim Sh As Worksheet
    Dim rng As Range
    Dim r As Integer
    Dim Cell As Range
    Dim FirstAddr As String
    Dim LR As Integer
 
 
    Set Sh = Worksheets("bdCarr")
 
    LR = Sh.Range("M65536").End(xlUp).Row + 1 'Sh.Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Sh.Range("M2:Q" & LR)
    r = 0
    Feuil1.ListBox3.Clear
    With rng
        Set Cell = .Find(What:=Feuil1.ListBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not Cell Is Nothing Then
            FirstAddr = Cell.Address
            Do
    With Feuil1.ListBox3
    .AddItem Cell.Cells(1, 13).Value '13 --> colonne M
    .List(r, 1) = Cell.Cells(1, 14).Value '14 --> colonne N
    .List(r, 2) = Cell.Cells(1, 15).Value '15 --> etc...
    .List(r, 3) = Cell.Cells(1, 16).Value
    .List(r, 4) = Cell.Cells(1, 17).Value
    r = r + 1
    End With
 
            Set Cell = .FindNext(Cell)
            Loop While Not Cell Is Nothing And Cell.Address <> FirstAddr
        End If
    End With
End Sub

merci

[BERRACHED SAID]

Bonjour le forum

après plusieurs tentative j'ai enfin trouvé la solution qui fonctionne

voici le code si quelqu'un en a besoin un jour :

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
Dim Plage As Range, cell As Range
Dim Recherche As String, Adresse As String
Dim Ligne As Integer, n As Integer
Dim C As Range
Feuil1.ListBox3.Clear
n = 0
Recherche = Feuil1.Txtb1.Value
Ligne = Sheets("bdCarr").Range("M" & "65536").End(xlUp).Row
Set Plage = Sheets("bdCarr").Range("M" & "2:" & "M" & Ligne)
With Plage
Set C = .Find(Recherche, , xlValues)
If Not C Is Nothing Then
Adresse = C.Address
Do
    If UCase(Recherche) = UCase(Left(C, Len(Recherche))) Then
        Feuil1.ListBox3.AddItem C.Offset(0, 0), n
         Feuil1.ListBox3.List(n, 1) = C.Offset(0, 1)
          Feuil1.ListBox3.List(n, 2) = C.Offset(0, 2)
           Feuil1.ListBox3.List(n, 3) = C.Offset(0, 3)
            Feuil1.ListBox3.List(n, 4) = C.Offset(0, 4)
                n = n + 1
    End If
    Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> Adresse
    End If
End With

Bonne journée