XL 2013 Assembler texte

[maval]

Bonjour,

J'ai une colonne "D" avec des noms de communes

Dans la colonne "I " j'ai une liste de noms plus ou moins la même que la colonne "D" et dans la colonne "J" j'ai des noms d'habitants des communes qui correspond à la colonne" I".

Mon problème est que je voudrai si possible à l'aide d'une macros assembler les noms des habitants de la colonne "j" qui correspond aux noms de la colonne "D" en sachant qu'il y a des noms qui ne figure pas dans les deux sens.

Mon fichier exemple

Je vous remercie d'avance

Max

 

[Millai]

Bonsoir,

Regarde si c'est bon !

 

[maval]

Re,

Nickel tu est devenu un pro du VBA

 

[Millai]

Attention, pour certaine ville ça ne fonctionne pas car il y a une différence dans les nom :

Exemple :
En colonne D il y a Épieds avec un accent mais en face il y a Epieds dans la colonne I sans accent, ils sont donc différent est le code de s'applique par pour eux.

 

[maval]

Ok

 

[Compte Supprimé 979]

Bonjour le fil,

Pour les problèmes d'accent, on peut utiliser une petite fonction 😉

Sub Bouton1_Cliquer()
  'Déclaration des variables
  Dim rngColumnI As Range, rngColumnD As Range, Find As Range
  Set rngColumnI = Range("I5:I820")
  Set rngColumnD = Range("D5:D808")

  Dim element As Variant

  'Blocage du refresh de l'interface
  Application.ScreenUpdating = False

  'Boucle sur toute les cellules (dans la range) dans J
  For Each element In rngColumnI
    'Cherche si la cellules existe aussi dans D
    Set Find = rngColumnD.Cells.Find(What:=SupAccents(element), lookat:=xlWhole)
    'Condition si la valeur est trouvé
    If Not Find Is Nothing Then
      'Recopie de la valeur dans J pour la mettre dans E
      Range("E" & Find.Row) = (Range("J" & element.Row))
    End If
  Next

  'Déblocage du refresh de l'interface
  Application.ScreenUpdating = True
End Sub

Function SupAccents(ByVal sChaine As String) As String
  Dim sTmp As String, i As Long, p As Long
  Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
  Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
  sTmp = sChaine
  For i = 1 To Len(sTmp)
    p = InStr(sCarAccent, Mid(sTmp, i, 1))
    If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
  Next i
  SupAccents = sTmp
End Function

A+

 

[maval]

Bonjour Bruno,

Je te remercie mais je pense qu'il y a un petit problème parce que à la base il y a 507 lignes dans la colonnes "J" et avec la fonction on retrouve que 408 lignes ?

Ou j'ai pas compris....

Max

 

[maval]

Bonjour

Personne a une idée pour que sa fonctionne

Merci

 

[pierrejean]

Bonjour maval

Curieux !! Chez moi la distinction est bien faite
Essaie en ajoutant en tête de module : Option compare Binary

 

[maval]

Bonjour Pierrejean

Non sa ne donne rien tout les noms avec des accents sont ignorés?????

Merci

Max

 

[pierrejean]

Re
Ais_je Bien compris ?
Tu souhaites que l'on ignore les les accents pour faire la comparaison ou que l'on différencie
Par exemple pour Épieds veux-tu que l'on mette Eppois Eppoises ou que l'on s'abstienne ?

 

[maval]

Re,

Oui en faite il faut pas s'occuper des accents. si dans la colonne "J"il y a un gentilé il doit être copier dans la colonne "E"

 

[pierrejean]

Re
Voila une version qui ignore les É en Initiale dans la colonne D
Pour les autre accents on dépasse les capacités de traitement (au mons sur mon PC )
Si impératif de tout traiter revient et j'essaierai d'aller plus à fond

 

[pierrejean]

Re
Voici une version qui traite tous les accents selon cette liste : "ÉÈÊËÔéèêëàçùôÛûïî"