rechercher du texte avec/sans accent

Bonsoir Daniel, le Forum

Interressant comme question, surtout dans mon projet actuel pour ce Forum...

A froid comme çà, il ne me vient pas de solution miracle mis à part de faire boucler sur tous les accents possible dans les caractères contenus dans la string recherchée... Mais ouf même pas imaginable sur une base de données de plus de 60000 lignes...

Enfin pour le fun... (NB je traite que le "e" (MAJ ou min) pour retrouver les occurences "ê", "è", "é", "ë"... Mais je le dis d'avance çà ne passera pas avec "Hétérogène", car çà ne fait qu'un passage par possibilité d'accent sur le "e"... (donc un accent c'est bon, deux fois le même accent c'est bon, mais trois accents dont un différent ... niet !! enfin si çà te donne des idées...


Option Explicit
Option Compare Text

Sub SearchString()
Dim TheString As String
Dim Y As Byte, X As Byte, S As Integer, i As Integer

TheString = InputBox("Saississez le texte à rechercher", "Recherche avec ou sans accent sur le E")

Searching TheString
Y = Len(TheString)
For S = Y To 1 Step -1
If Mid(TheString, S, 1) = "e" Then
For i = 232 To 235
TheString = Mid(TheString, 1, S - 1) & Chr(i) & Mid(TheString, S + 1, Y)
Searching TheString
Next i
End If
Next S
End Sub


Sub Searching(TheString As String)
Dim Cell As Range
Dim FirstAddress As String
Dim i As Integer

With Sheets("Feuil1").UsedRange
Set Cell = .Find(TheString)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
MsgBox TheString & " Trouvée dans " & Cell.Address
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
End If
End With
End Sub


Et en plus faudrait faire les autres lettres susceptibles d'avoir un accents !!! A moins que quelqu'un connaisse une fonction toute prête ou un passage ascii / ansi ... mais là je sèche

Bonne nuit
@+Thierry

Salut Daniel et @Thierry

Pourquoi pas supprimer toutes les accents dans les mots

Une Fonction de Alain Vallon

Function Sup_Acc(Chaine$)

Dim Tmp As String
Dim I As Byte
Dim X As String

Tmp = Trim(Chaine)

For I = 1 To Len(Tmp)
X = Asc(Mid(Tmp, I, 1))
Select Case X
Case 192 To 197: X = "A"
Case 200 To 203: X = "E"
Case 204 To 207: X = "I"
Case 209: X = "N"
Case 210 To 214: X = "O"
Case 217 To 220: X = "U"
Case 221: X = "Y"
Case 224 To 229: X = "a"
Case 232 To 235: X = "e"
Case 236 To 239: X = "i"
Case 241: X = "n"
Case 240, 242 To 246: X = "o"
Case 249 To 252: X = "u"
Case 253, 255: X = "y"
Case Else: X = Chr(X)
End Select
Sup_Acc = Sup_Acc & X
Next I
End Function

Mytå

Bonjour Mytå, Daniel, le Forum

Cà fait un moment que l'in ne s'est pas croisé dans un Fil Mytå, merci pour cette très belle Fonction de AV, oui c'est une alternative, mais j'ai comme dans l'idée que notre ami Saniel veut garder son texte en l'état d'origine...

Mais peut-être qu'en appliquant cette fonction dans l'ordre inverse, on doit pouvoir faire la recherche... Enfin c'est à tester et c'est surtout dépendant de la taille du tableau à scanner...

Bon Vendredi !!! T.G.F.!!!
@+Thierry