vlook up sur string en vba sans tenir compte des accents et de la casse

[osishame]

Hello le forum,

Impossible d'introduire dans ma macro la création de formules vlookup à partir d'une chaîne de caractères (sans prendre en compte les accents et les majuscules) à l'aide de la fonction suivante :

Sub formule()
iend = Range("A65536").End(xlUp).Row
For i = 2 To iend
Cells(i, 4).FormulaR1C1 = "=SI(ESTERREUR(RECHERCHEV(SetTranslate(A2);BE!A😀;4;FAUX));""; (RECHERCHEV(SetTranslate(A2);BE!A😀;4;FAUX)))"
Next i
End Sub

--

Private Function SetTranslate(ByVal strTemps As String) As String
' Déclaration des variables.
Dim lngI As Long
Dim lngJ As Long
Dim strCharts As String
Dim strResult As String

' Modification des caractères
lngJ = Len(strTemps)
strTemps = LCase(strTemps)
If lngJ >= 1 Then
For lngI = 1 To lngJ
strCharts = Mid$(strTemps, lngI, 1)
Select Case strCharts
Case "'": strCharts = " "
Case "î": strCharts = "i"
Case "é": strCharts = "e"
Case "è": strCharts = "e"
Case "ê": strCharts = "e"
Case "ë": strCharts = "e"
Case "à": strCharts = "a"
Case "ä": strCharts = "a"
Case "ô": strCharts = "o"
Case "ö": strCharts = "o"
End Select
SetTranslate = SetTranslate & strCharts
Next lngI
End If

End Function

J'inclus le fichier en PJ avec le résultat souhaité pour plus de transparence...

Merci de votre aide.
Bonne soirée.

osi.

 

[BOISGONTIER]

Re : vlook up sur string en vba sans tenir compte des accents et de la casse

Bonjour,

cf pj

Sub formule()
'remplissage des test
  iend = Range("A65536").End(xlUp).Row
  For i = 2 To iend
    Cells(i, 4).FormulaR1C1 = "=RechvSansAccent(RC[-3],BE!R2C1:R12C6,4)"
  Next i
End Sub

Function RechvSansAccent(quoi, table As Range, colonne)
  Application.Volatile
  a = table
  For i = LBound(a) To UBound(a)
    If UCase(sansAccent(a(i, 1))) = UCase(sansAccent(quoi)) Then
      RechvSansAccent = a(i, colonne): Exit Function
    End If
  Next i
  RechvSansAccent = "inconnu"
End Function

Function sansAccent(chaine)
  codeA = "ÉÈÊËÔéèêëàçùôûïî"
  codeB = "EEEEOeeeeacuouii"
  temp = chaine
  For i = 1 To Len(temp)
     p = InStr(codeA, Mid(temp, i, 1))
     If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function

jb