Utilisation de la fonction FIND et OR

alexamel88

XLDnaute Junior
Salut à tous

Me revoilà confrontée à un problème qui parait simple à la base mais je n'arrive pas à le résoudre.
J'ai une colonne avec des coordonnées des gens, plusieurs personnes avec noms et prenoms mises dans uen seule cellule, le but étant de séparer chacune des personnes dans une colonne séparée et aussi séparer le nom et le prénom, sachant que ceux-ci peuvent être séparée dans la colonne pas des caractères différents: à savoir un espace, ou une virgule ou un point virgule: Par exemple:
Cellule A1:
Stephanie Savoir; Melanie Degroot, Simon Dubois
Je voudrai creer des cellules A2, A3, A4,.... A2 etant le prénom de la premiére personne, A3 son nom, A4, le prénom de la deuxième personne, et ainsi de suite. J'ai essayé d'utiliser la formule FIND(",", A1) pour identifier les ,mais je dois aussi identifier les espaces ou d'autres caractères spéciaux qui séparent les donnes et je ne sais pas comment procéder.
Merci infiniment pour votre aide précieuse.

Agnès
 

Pièces jointes

  • Template.xls
    24 KB · Affichages: 57
  • Template.xls
    24 KB · Affichages: 60
  • Template.xls
    24 KB · Affichages: 62

Vorens

XLDnaute Occasionnel
Re : Utilisation de la fonction FIND et OR

Hello Alexam,


Ce que tu cherche à faire relève du traitement des chaines de caractères et pour cela il te faut aller faire un tour sur ce Tuto qui contient la solution à ton problème.

Manipuler les chanes de caractres en VB6 et VBA Excel

Je connais pas ton niveau de programmation mais si tu as les bases qu'il faut avoir pour faire mumuse avec VBA tu trouvera rapidement la solution.

Meilleures salutations
 

Dull

XLDnaute Barbatruc
Re : Utilisation de la fonction FIND et OR

Salut alexamel88, Vorens, le Forum

Sinon il y a
Sélectionner la Plage

Données/Convertir
Bouton Délimité
Suivant
Cocher comme séparateur: Virgule et Autre
dans Autre mettre le signe &
Suivant
Choisir la cellule de destination ex: A15
et Terminer

Bonne Journée
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Utilisation de la fonction FIND et OR

Bonjour le fil, bonjour le forum,

La complexité vient du fait que les séparateurs peuvent être différents...
Je te propose une solution VBA qui ne fait le travail qu'en partie. Au final tu verras en rouge les cellules non traités pour une des raisons ci-dessous :
• pénoms composés séparés par un espace : Jean Claude
• pénoms composés séparés par un tiret : Jean-Marie
• il y a des parenthèses au milieu qui font partie de quoi. Nom ou Prénom ?
Bien sûr, il risque d'y avoir encore d'autres cas non envisagés...
le code :
Code:
Sub Macro1()


Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim deli As String 'déclare la variable deli (DELImitor)
Dim c As Integer 'déclare la variable c (Colonne)
Dim dc As Integer 'déclare la variable dc (Dernière Colonne)With Sheets("Sheet2") 'pren cn compte l'onglet "Sheet2"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'd;efinit la dernière ligne éditée dl de la colonne A
    Set pl = .Range("A2:A" & dl) 'définit la plage pl
    For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
        If cel.Value Like "*&*" = True Then deli = "&" 'si la cellule contient le caractère "&" , definit deli avec ce caractère
        If cel.Value Like "*,*" = True Then deli = "," 'si la cellule contient le caractère "," , definit deli avec ce caractère
        If cel.Value Like "*;*" = True Then deli = ";" 'si la cellule contient le caractère ";" , definit deli avec ce caractère
        If cel.Value Like "*:*" = True Then deli = ";" 'si la cellule contient le caractère ":" , definit deli avec ce caractère
        
        For x = 0 To UBound(Split(cel.Value, deli)) 'boucle 2 : sur le nombre de fois que le caractère apparaît dans la cellule
            'décompose la cellule en autant de fois qu'il a le caractère et en supprimant les espaces avant et après
            cel.Offset(0, x + 1).Value = Trim(Split(cel.Value, deli)(x))
        Next x 'prochaien fois de la boucle 2
    
    Next cel 'prochaine cellule de la boucle 1
    
    'insère des colonnes
    For c = .Cells(2, Application.Columns.Count).End(xlToLeft).Column To 2 Step -1  'boucle inversée de l'avant dernère colonne éditée de la ligne 2 à la colonne 2
        .Cells(1, c).Value = "Prénom"
        .Columns(c + 1).Insert Shift:=xlToRight 'insère une colonne à droite
        .Cells(1, c + 1).Value = "Nom"
    Next c 'prochaine colonne de la boucle
    
    dc = .Cells(2, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonn eéditée de la ligne 2
    For Each cel In .Range(.Cells(2, 2), Cells(dl, dc)) 'boucle sur toute les cellules de la plage B2:cellule(dl,dc)
        If cel.Value <> "" Then 'condition 1 : si la celluole n'est pas vide
            If cel.Value Like "*(*" = True Or cel.Value Like "*-*" Then 'condition 2 : si la cellule contient ou une parenthèse "(" ou un tiret "-"
                cel.Interior.ColorIndex = 3 'colore la cellule en rouge (signifie non traitée)
            Else 'sinon
                If UBound(Split(cel.Value, " ")) = 1 Then 'condition 3 "si un seul espace entre nom et prénom
                    cel.Offset(0, 1).Value = Trim(Split(cel.Value, " ")(1)) 'récupère le nom dans la cellule à coté
                    cel.Value = Trim(Split(cel.Value, " ")(0)) 'récupère le prénom dans la cellule
                Else 'sinon
                    If 2 Mod cel.Column = 0 Then cel.Interior.ColorIndex = 3 'colore la cellule en rouge (signifie non traitée)uniquement si la colonne est paire
                End If 'fin de la condition 3
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next cel 'prochaine cellule de la boulce
End With 'fin de la pros en compte de l'onglet "Sheet2"
End Sub
Le fichier :

[Édition]
Nos posts se sont croisé. Bonjour Dull ! Mais pourquoi tu fais simple alors qu'on peut faire si compliqué... ?
 

Pièces jointes

  • Agnès_v01.xls
    39 KB · Affichages: 54
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
314 121
Messages
2 106 128
Membres
109 495
dernier inscrit
jerome bonneau