Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

  • Initiateur de la discussion Initiateur de la discussion osishame
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

osishame

XLDnaute Junior
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.
 

Pièces jointes

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

Bonjour,

cf pj

Code:
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
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…