Supprimer accent, mais pas tous !!

Fonmaz

XLDnaute Junior
Bonjour à tous et avant tout meilleurs voeux pour cette nouvelle année 2010, somme toute assez binéraire non ?
Bonne année donc !
Voilà mon petit soucis. Je travaille sur une base de sportifs, et selon les épreuves j'ai des fichiers avec accents et d'autres pas. Ce que je voudrais faire, c'est supprimer tous les accents en gardant la casse, sauf les accents sur les prénoms francophones. Exemple un français qui se prénomme José ou Sébastien. En revanche s'il est espagnol, portugais ou plus largement d'amérique du sud, je voudrais supprimer l'accent : Jose ou Sébastien. Est-ce possible.
Je peux bien sûr identifier, les nationalités des sportifs.
Ci joint un bout de fichier. Merci aux excellents contributeurs du forums de m'aider. Je ne maitrise pas VBA, mais je sais faire des macros.
Bonne journée.
 

Pièces jointes

  • Fichiers noms accents.xls
    17.5 KB · Affichages: 74

Dull

XLDnaute Barbatruc
Re : Supprimer accent, mais pas tous !!

Salut Fonmaz, le Forum

Peut-être avec cette Formule

Code:
=SI(OU(C5="FRA";C5="BEL");B5;SUBSTITUE(B5;"é";"e"))
Fichier Joint

Bonne Journée
 

Pièces jointes

  • Fonmaz.zip
    6.8 KB · Affichages: 34
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Supprimer accent, mais pas tous !!

Bonjour Dull, Fonmaz
Une solution par macro.
Cordialement

Edit : Sur les conseils avisés de Dull, modification du code pour prendre en compte les "Belges".
 

Pièces jointes

  • Fichiers noms accents(2).xls
    30.5 KB · Affichages: 108
Dernière édition:

Gruick

XLDnaute Accro
Re : Supprimer accent, mais pas tous !!

Bonjour,

Il n'y a pas que des zaxant tégus, par exemple François, Noël, Hélène, Benoît.
Aussi, je me permets de proposer cette macro, à adapter ou compléter selon le pays (France, Belgique, Suisse... partout où que ça cause la France...)
Code:
Sub sansaccents()
' Remplace tous les caractères spéciaux par leur équivalent naturel
' Définition de la conversion
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿ ÑñÇç-'"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuy NnCc  "
Dim i As Integer
Dim lettre As String * 1
For Each mot In Selection
  For i = 1 To Len(accent)
    lettre = Mid$(accent, i, 1)
    If InStr(mot, lettre) > 0 Then
      Nllelettre = Mid$(noAccent, i, 1)
      'MsgBox "la lettre " & lettre & " sera remplacée par la lettre " & Nllelettre
      mot.Replace what:=lettre, replacement:=Nllelettre, lookat:=xlPart
    End If
  Next i
Next mot
End Sub

François allais Gruick, qui tient à sa cédille.
 

Dull

XLDnaute Barbatruc
Re : Supprimer accent, mais pas tous !!

Re le Fil:)

Ne me force pas à prendre mon accent de Boucher-Charcutier-Fermier Gruick :p. Fonmaz demandait une chose simple et toi tu nous pond... Mourafff...uncochonquipond... :D Heu...Désolé :eek:, Un code de ouf, que je garde précieusement.

Merci François pour tes codes et tes délires:)

Bonne Journée
 

Gruick

XLDnaute Accro
Re : Supprimer accent, mais pas tous !!

Hugh Dull,

Ben j'en parlerai à mon cousin Jérôme, et à Thérèse, une grande amie de Gaël.
J'ai simplement prévu la suite de la question qui se posera un moment ou un autre.
Ce code n'est pas mien, je l'ai trouvé, Chépluoù
Gruick, cochon élitiste


Edit : Pas trouvé ton vert original, avec accent réunionnais j'espère
 
Dernière édition:

Fonmaz

XLDnaute Junior
Re : Supprimer accent, mais pas tous !!

Dull, Gruick, Efgé un grand merci pour vous être intéressé à mon cas. Effectivement le code de Gruick est allucinant. Et je ne comprends pas tout. Est ce que cette macro prend en compte toutes les autres nationalités que "les francophones" pour y supprimer les accents et le reste ?
Je ne comprend pas non plus "à adapter ou compléter selon les pays" comme le dit Gruick. Je ne sais pas dans l'état de mes connaissances adapter le code.
En fait au secooooooooooooooours Gruick !!!!
 

Fonmaz

XLDnaute Junior
Re : Supprimer accent, mais pas tous !!

Re bonsoir mes sauveurs. Ci dessous la macros de EFGE et plus loin celle de GRUICK

Sub Macro2()
Dim i As Long
For i = 2 To 1000
If Not Cells(i, 3).Value = "FRA" And Not Cells(i, 3).Value = "BEL" Then
Cells(i, 4).Replace What:="é", Replacement:="e"
End If
Next
End Sub


Sub sansaccents()
' Remplace tous les caractères spéciaux par leur équivalent naturel
' Définition de la conversion
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿ ÑñÇç-'"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuy NnCc "
Dim i As Integer
Dim lettre As String * 1
For Each mot In Selection
For i = 1 To Len(accent)
lettre = Mid$(accent, i, 1)
If InStr(mot, lettre) > 0 Then
Nllelettre = Mid$(noAccent, i, 1)
'MsgBox "la lettre " & lettre & " sera remplacée par la lettre " & Nllelettre
mot.Replace what:=lettre, replacement:=Nllelettre, lookat:=xlPart
End If
Next i
Next mot
End Sub

Il est effectivement vrai que GRUICK a bien anticipé avec toutes les autres formes d'accents. EFGE me sort l'épine du pied de la reconnaissance des pays francophones "FRA" "BEL" "SUI" etc...
La macros de EFGE fonctionne parfaitement mais seulement pour le "é" "e"
Je ne sais pas transférer le code des pays de EFGE dans la macros de GRUICK qui me changerait visiblement tous les accents en gardant ceux des prénoms francophone.

Merci de m'aider un peu. Car je vois pleins de cheveux au pied de ma chaise. C'est pas bon signe ça !!!!
 

Efgé

XLDnaute Barbatruc
Re : Supprimer accent, mais pas tous !!

Bonjour Fonmaz,
Chez moi ce code fonctionne
Code:
Sub sansaccents()
' Remplace tous les caractères spéciaux par leur équivalent naturel
' Définition de la conversion
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜù úûüÿ ÑñÇç-'"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUu uuuy NnCc "
Dim i As Integer
Dim lettre As String * 1
Dim v As Long

For v = Range("C65536").End(xlUp).Row To 2 Step -1
    If Not Cells(v, 3).Value = "FRA" And Not Cells(v, 3).Value = "BEL" Then
        Cells(v, 4).Select
        For Each mot In Selection
            For i = 1 To Len(accent)
            lettre = Mid$(accent, i, 1)
                If InStr(mot, lettre) > 0 Then
                    Nllelettre = Mid$(noAccent, i, 1)
'MsgBox "la lettre " & lettre & " sera remplacée par la lettre " & Nllelettre
                    mot.Replace what:=lettre, replacement:=Nllelettre, lookat:=xlPart
                End If
            Next i
        Next mot
    End If
Next v
End Sub

Cordialement
 

Pièces jointes

  • Fichier noms accents(3).xls
    33 KB · Affichages: 86
Dernière édition:

Statistiques des forums

Discussions
312 502
Messages
2 089 046
Membres
104 010
dernier inscrit
Freba