Comment afficher tous les résultats qui contients la valeur d'une celllule

Bonjour,

un essai:

Option Explicit
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer, col As Integer
Dim NoLig As Long, Var As Variant, ligne As Long
Dim nombre As Integer, mafeuille As String
Dim nom As String

mafeuille = InputBox("Nom de la feuille", "Feuille", "Feuil1")
col = InputBox("Numero colonne nom", "Colonne nom", "1") 'col lecture de la colonne nom
NoCol = InputBox("Numero colonne reference", "Colonne reference", "2") 'NoCol lecture de la colonne reference
    Set FL1 = Worksheets(mafeuille)
    For NoLig = 1 To Cells(Rows.Count, NoCol).End(xlUp).Row  'boucle colonne reference
        Var = FL1.Cells(NoLig, NoCol)
        nombre = Len(Var) 'nombre caracteres
        For ligne = 1 To Cells(Rows.Count, col).End(xlUp).Row 'boucle colonne nom
         nom = Left(FL1.Cells(ligne, col), nombre) 'nombre caracteres à gauche
       If nom = Var Then
   Range("C" & NoLig) = Range("C" & NoLig) & FL1.Cells(ligne, col) & ", "
    End If
    Next
    Next
    Set FL1 = Nothing
End Sub

voilà

merci !!!!!

@+

bonjour,
qu'as-tu essayé pendant ces journées?
si tu avais une colonne par référence, tu pourrais faire cela plus simplement, avec des formules.

J'ai essayé cela aussi, mais je n'ai pas trouvé la bonne formule ou des fois je n'ai pas réussi à la faire fonctionner :/

Le code VBA c-dessous m'a donné des meilleurs résultats, mais dès fois pour je ne sais pas quelle raison il n'affiche pas des résultats alors le fichiers correspondant est bien présent dans le dossier spécifié. -> la fonction qui me permet de chercher dans les noms des fichiers présents dans un dossier spécifié est vraiment géniale, car cela m'évite de copier la liste des noms à chaque fois dans l'excel manuellement.

Ce n'est pas mon code du coup j'essaye de l'adapter pour mon besoin mais je galère :/

Merci pour votre temps!

Public Sub MatchListWithPics()
'look for a string to search (list of references)
'and search all files in a folder and look inside names

Dim SuppRefLst As Range
Set SuppRefLst = Application.InputBox("Please select the cells with Supplier References", Type:=8)

maxFiles = 5 'upload up to 5 files to the website
'select folder with pics to look into names
searchIn = ListFilesinFolder

'add reference and result
ReDim finalResult(1 To SuppRefLst.Rows.Count, 0 To maxFiles) As String '0 is for initial reference

For I = 1 To SuppRefLst.Rows.Count

StrToSearch = SuppRefLst(I, 1).Value

ReDim Res(1 To maxFiles) As Variant
Res = FindText_IgnoreCase(StrToSearch, searchIn, maxFiles)

For j = 1 To maxFiles
If j = 1 Then finalResult(I, 0) = StrToSearch
finalResult(I, j) = Res(j)
Next j
Next I

'to write Results inside new book
Workbooks.Add
Range("A1").Resize(SuppRefLst.Rows.Count, maxFiles + 1) = finalResult '+1 for supplier reference
Cells.Columns.AutoFit

Erase finalResult
End Sub
Public Function ListFilesinFolder()
'ONLY PICTURES

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim I As Integer

fLocation = SelectFolder("please select a folder!")

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(fLocation)

ReDim Result(1 To oFolder.Files.Count, 1 To 1) As String

For Each oFile In oFolder.Files
If LCase(Split(oFile.Name, ".")(1)) = "jpg" Or LCase(Split(oFile.Name, ".")(1)) = "jpeg" _
Or LCase(Split(oFile.Name, ".")(1)) = "bmp" Or LCase(Split(oFile.Name, ".")(1)) = "png" _
Or LCase(Split(oFile.Name, ".")(1)) = "ico" Or LCase(Split(oFile.Name, ".")(1)) = "gif" Then

Result(I + 1, 1) = oFile.Name
I = I + 1
End If
Next oFile

ListFilesinFolder = Result

Erase Result
End Function

Public Function FindText_IgnoreCase(ByVal searchWhat As String, ByVal SearchArray As Variant, ByVal maxF As Integer) As Variant
ReDim Result(1 To maxF) As Variant
Dim cpt As Integer
cpt = 1

For I = 1 To UBound(SearchArray, 1)
'replace special characters in both string for more accurate search
sourceStr = ReplaceSpecialCharacters(SearchArray(I, 1))
whatStr = ReplaceSpecialCharacters(searchWhat)
whatStrShort = ReplaceSpecialCharacters(searchWhat, 12)

If InStr(1, sourceStr, _
whatStr, vbTextCompare) _
> 0 Then 'no case Sensitivity

'add to result if < maxFiles
If cpt <= maxF Then
Result(cpt) = SearchArray(I, 1)
cpt = cpt + 1
End If
ElseIf sourceStr Like "*" & whatStrShort & "*" = True _
And SearchArray(I, 1) <> "" Then

'add to result if < maxFiles
If cpt <= maxF Then
Result(cpt) = SearchArray(I, 1)
cpt = cpt + 1
End If

End If
Next I

FindText_IgnoreCase = Result
Erase Result
End Function

Public Function ReplaceSpecialCharacters(ByVal myString As String, Optional ByVal lengthOutput As Integer = 0)
Dim SpecialCharacters As String
SpecialCharacters = "-,_,#" 'modify as needed

Dim newString As String
Dim char As Variant

'pass the value
newString = myString
For Each char In Split(SpecialCharacters, ",")
'change characters one by one, replace it by space
newString = Replace(newString, char, " ")
Next

If lengthOutput > 0 Then
ReplaceSpecialCharacters = Left(newString, lengthOutput)
Else
ReplaceSpecialCharacters = newString
End If

End Function