XL 2013 Assembler texte

maval

XLDnaute Barbatruc
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
 

Pièces jointes

  • Convertir.xlsm
    73.3 KB · Affichages: 8

Millai

XLDnaute Nouveau
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.
 
C

Compte Supprimé 979

Guest
Bonjour le fil,

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

VB:
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+
 

pierrejean

XLDnaute Barbatruc
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
 

Pièces jointes

  • Convertir.xlsm
    84.3 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 724
Membres
110 552
dernier inscrit
jasson