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
| Dim Result As Range
Dim varCellule, varfirstAddress As Variant
Dim strParam, strReponse, strcible As String
Dim strTableau() As String
Dim i, j, DerniereLigne As Integer
Sheets("Feuil2").Select
DerniereLigne = Range("C2").CurrentRegion.End(xlDown).Row
For j = 2 To DerniereLigne
strTableau = Split(Cells(j, 3), " ")
'boucle sur le strTableau pour visualiser le résultat
For i = 0 To UBound(strTableau)
'Trouver la première cellule correspondante
Sheets("Feuil3").Select
On Error Resume Next
strParam = strTableau(i)
strcible = "&"
If strcible = strParam Then
strParam = strTableau(i + 1)
End If
With ActiveWorkbook.Sheets("Feuil3")
Set Result = Range("A:A").Find(What:=strParam)
varCellule = Result.Value
If varCellule > 0 Then
MsgBox "Le fournisseur cherché est " & Sheets("Feuil2").Cells(j, 3).Value & _
". La correspondance trouvée est " & varCellule & ". Voulez-vous continuer la recherche?", vbYesNo
If strReponse = vbNo Then
Sheets("Feuil2").Cells(j, 4).Value = varCellule
End If
End If
End With
'Trouver les cellules correspondantes suivantes
If Not Result Is Nothing Then
varfirstAddress = Result.Address
Do
MsgBox "Le fournisseur cherché est " & Sheets("Feuil2").Cells(j, 3).Value & _
". La correspondance trouvée est " & varCellule & ". Voulez-vous continuer la recherche?", vbYesNo
If strReponse = vbNo Then
Sheets("Feuil2").Cells(j, 4).Value = varCellule
End If
Set Result = Range("A:A").FindNext(Result)
varCellule = Result.Value
Loop While Not Result Is Nothing And Result.Address <> varfirstAddress
End If
Next i
Next j
End Sub |
Partager