Problème fonction rechercheX

Bonjour à toutes et tous,

Je vous sollicite car j'ai un problème sur les résultats obtenus par ma fonction recherchex mais je n'arrive pas à trouver de solution malgré plusieurs essais de mon côté. Etant à court d'idées, j'espère que vous pourrez m'apporter la solution.

Dans le fichier ci-joint, vous trouverez deux onglets "Balance" et "Table Centres", le but est de faire une recherchex de la colonne D de l'onglet "Balance" en fonction de l'onglet "Table Centres" de la colonne J (le changement de la colonne pour prendre la colonne K par exemple n'est pas possible car d'autres activités ne sont pas sous ce format), j'ai donc fait le code suivant.

Code qui fonctionne très bien en soit sauf qu'il m'arrive d'avoir des données séparées par une virgule dans la colonne J ce qui amène un #N/A dans mon onglet "Balance".

Do While Sheets("Balance").Range("C" & j).Value <> ""
    If Sheets("Balance").Range("D" & j).Value <> "" Then
        Sheets("Balance").Range("N" & j).FormulaLocal = Application.XLookup(Sheets("Balance").Range("D" & j), Sheets("Table Centres").Range("J:J"), Sheets("Table Centres").Range("F:F"))
    End If
    Sheets("Balance").Range("L" & j).Value = 1
    j = j + 1
Loop

J'ai donc voulu faire un balayage pour isoler les données avant et après la virgule avec le code ci-dessous mais sans succès

CodeCentre = Application.XLookup(Sheets("Balance").Range("D" & j), Sheets("Table Centres").Range("J:J"), Sheets("Table Centres").Range("F:F"))
If InStr(CodeCentre, ",") <> 0 Then
    CodeCentre2 = Left(CodeCentre, InStr(CodeCentre, ",") - 1)
    CodeCentre = Right(CodeCentre, Len(CodeCentre) - InStr(CodeCentre, ","))
Else
    CodeCentre2 = CodeCentre
End If

J'espère avoir été assez clair dans mes explications, vous trouverez un exemple de mes explications dans ce fichier.

Merci d'avance si vous prenez le temps de vous pencher sur ce sujet.

Bonne journée.

Bonsoir,

Essayez ceci:

Sub test()
    Dim j As Long
    Dim CodeCentre As Object
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("Table Centres")
    Set f2 = Sheets("Balance")

    For j = 2 To 6
        With f1.Range("J:J")
            Set CodeCentre = .Find(f2.Range("D" & j), lookat:=xlPart)
            If Not CodeCentre Is Nothing Then f2.Cells(j, "N") = f1.Cells(CodeCentre.Row, "F")
        End With
    Next j
End Sub

Cdlt

Bonjour Clem,

Voici une proposition où j'ai essayé de rester dans ta logique.

J'ai simplement ajouter une boucle en début de ton programme qui va créer en colonne AA et AB la liste en démultipliant les lignes qui contiennent 2 codes.

Après, il suffisait d'adapter ton code recherche pour aller chercher dans ces colonnes "techniques" les informations.

A noter que tu peux masquer ces 2 colonnes puisqu'elles ne servent que pour le VBA.

Tu peux également les placer ailleurs que AA et AB si elles te gênent mais il faudra adapter le VBA en conséquence.

Bonne continuation

Chris

Bonjour Messieurs,

Tout d'abord merci de vous être penché sur ce sujet.

Vos deux codes répondent parfaitement à ce que je voulais.
Je vais intégrer cela à ma macro finale qui est plus complexe que l'extrait que je vous ai transmis pour voir quelle méthode est la plus adéquat pour moi.

Je vous tiens au courant si j'ai des points bloquants ou pas à ce niveau.

Encore merci