XL 2016 Inverser Nom et prénom si nécessaire..

[harveyspecter]

Bonjour à tous,


Je souhaite inverse le nom et prénom d'une cellule. cela à marché grace a une formule.

Cependant, il m'arrive parfois de ne pas avoir besoin de modifier la cellule car on a bien le Prénom et Nom mais je ne peut pas la modifier a la main sur 100000 lignes

Ma question et comment ajouter une formule dans une nouvelle colonne pour lui dire de garder la cellule si elle existe bien et utiliser la formule si non ?
sachant que j'ai une base existante avec les bons prénom et noms avec laquelle je peut utiliser la recherchev.

Merci d'avance a ceux qui m'aideront

 

[sylvanu]

Bonjour Harveyspecter,

Vous pouvez essayer ça :

=SI(ESTERREUR(EQUIV(H11;Base;0)>0);SUPPRESPACE(DROITE(H11;NBCAR(H11)-TROUVE(" ";H11))&" "&GAUCHE(H11;TROUVE(" ";H11)));H11)

Base étant votre base de données.

Si H11 existe bien tel quel dans la base, on le garde sinon s'il n'existe pas on l'inverse.

Mais attention : JEAN Rémi et REMI Jean peuvent être deux personnes différentes. Mais je pense que c'est rare.

 

[harveyspecter]

merci pour ton retour.

cela ne marche pas
j'aurai voulu qu'il me cherche dans l'onglet tables le prénom et le nom et si il existe bien pas besoin d'inverser.

 

[sylvanu]

Je ne comprend pas, c'est excatement ce qu'il fait.

Si Nom H11 =benzema karim, il renvoie benzema karim
Si Nom H12=Pierre Dupont, il renvoie Dupont Pierre .

il répond toujours Nom Prénom

Où fais je une erreur de raisonnement ?

Et si vous voulez comme réponse Prénom Nom, il suffit de faire l'inverse :

=SI(ESTERREUR(EQUIV(H10;Tables!$C$3:$C$4;0)=1);H10;SUPPRESPACE(DROITE(H10;NBCAR(H10)-TROUVE(" ";H10))&" "&GAUCHE(H10;TROUVE(" ";H10))))

En PJ il y a les deux solutions.

NB : Votre RECHERCHEV(H10;Tables!$B$2:$C$4;2;FAUX) donne toujours #N/A, c'est pour ça que cela ne marche pas. Utiliser EQUIV le résultat est correct.

 

[harveyspecter]

salut,

j'ai surement mal du me faire comprendre.
Si Benzema Karim est dans la tables alors je ne modifie rien et si il ne l'est pas j'inverse son nom et prenom. De plus la formule ne marche pas si j'ai des noms composés séparé par un trait-ma

 

[sylvanu]

Bonjour,
Pouvez vous me dire dans la PJ quel exemple est faux à vos yeux ?
( Dans votre base de référence vous avez toujours soit Benzema Karim soit Karim Benzema ? ou les deux peuvent être absents ?)

 

[harveyspecter]

bonjour,

Pour les autres personnes ma formule marche parfaitement et je te remercie.

Cependant, si dans la table j'ai un nom composé avec un trait-ma et que la base(feuil1) il n'y en a pas cela ne marche pas c'est a dire les noms et prenoms sont inversé.
cf fichier

 

[sylvanu]

Ok, compris.
De par votre premier post je pensais que les noms prénoms étaient bons dans les deux bases.
S'il peut y a voir des fautes d'orthographes, je ne vois pas de solution en formules simples.
D'autant qu'avec Valéry Giscard d'Estaing je ne vois pas par formule ou même par VBA comment faire l'inversion à coup sur.
J'espère que quelqu'un d'autre sera mieux inspiré.

 

[dysorthographie]

Bonsoir,

Fichier joint: Prénoms recensés en Belgique en 2013!

Et c'est pas une blague!

Public Type N_Pn
    Nom As String
    PNom As String
End Type
Public Cn As Object, FichierXls As String

Public Sub OpenConnetion()
'ouvre la connexion au fichier Excel
'FichierXls non et chemin complet du fichier
'AvecTitre précise si la première ligne de l'onglet est les entête de colonnes ou pas
'rzutourne la connexion
On Error Resume Next
Dim HDR
If Dir(FichierXls) = "" Then MsgBox FichierXls & vbCrLf & "Pas trouvé": Exit Sub      ' versifie si le fichier existe
Set Cn = CreateObject("ADODB.Connection") 'Instancie un objet adosb c'est mieux que d'utiliser le références
With Cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FichierXls & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1;"""
        .Open
        If Err Then
            MsgBox Err.Description
            Set Cn = Nothing
        End If
        Err.Clear
        On Error GoTo 0
End With
End Sub
Public Function OpenRecordSet(Sql) As Object 'Retourne un recordset
If TypeName(Cn) = "Nothing" Then OpenConnetion
'Retourne un RecordeSet
On Error Resume Next
Set OpenRecordSet = CreateObject("ADODB.Recordset")
OpenRecordSet.Open Sql, Cn, 1, 3 'ouvre un recordset sur la requête SQL pour la connexion en lecteur écriture et ajou dynamique
If Err Then
    MsgBox Err.Description
Set OpenRecordSet = Nothing
End If
Err.Clear
On Error GoTo 0
End Function
Function IsPrenom(Pnm As String) As Boolean
FichierXls = ThisWorkbook.Path & "\Prénom.xlsx"
Dim Rs As Object
Set Rs = OpenRecordSet("select * from [Prénom$] Where [Prénom]='" & Replace(Pnm, "'", "''") & "'")
IsPrenom = Not (Rs.EOF)
Rs.Close: Set Rs = Nothing
End Function

Sub b()
Debug.Print NomPnom("Jean-Robert Marcel", False)

End Sub

Function NomPnom(txt, PNom As Boolean)
Dim t, i As Integer, Start As Boolean, Fin As Boolean, Nm As Boolean, Ispn As Boolean
t = Split(Replace(txt, "-", " ") & " ", " ")
For i = 0 To UBound(t) - 1
Ispn = IsPrenom(CStr(t(i)))
If Not Ispn Then Nm = True
    If Ispn = PNom Then
        Start = True
        If Start = True And Fin = False Then
           If PNom Then
            If CStr(NomPnom) <> "" Then NomPnom = NomPnom & "-"
           End If
           NomPnom = NomPnom & " " & CStr(t(i))
        
        End If
    Else
        If Start = True Then Fin = True
    End If
  
Next
 If Not Nm Then
        If PNom Then
        t = Split(txt & " ", " ")
        NomPnom = ""
        For i = 0 To UBound(t) - 1
            If CBool(InStr(1, t(i), "-")) Then NomPnom = t(i)
        Next
          
        Else
             NomPnom = ""
        For i = 0 To UBound(t) - 1
            If Not CBool(InStr(1, t(i), "-")) Then NomPnom = t(i)
        Next
          
       If NomPnom = "" Then NomPnom = txt
        End If
    End If

End Function

 

[harveyspecter]

bonjour,

Merci dysorthographie pour ton retour, est il possible de supprimer l'espace entre un "-", c'est à dire avoir Jean-François au lieu de Jean - François ?

De plus, est il possible d’accélérer le calcul du code car j'ai plus de 5000 lignes ??

Merci pour ton retour.

 

[GALOUGALOU]

bonjour harveyspecter bonjour le forum
je n'ai pas pu ouvrir ton classeur alors réponse théorique

pour remplacer les espaces inutiles en sélectionnant la feuille active attention fait un essai sur une copie du classeur pour voir si cette procédure te convient, tous les espaces considérés inutile seront supprimés

Sub Rempl()
Dim feuil As Worksheet
Range("A1:A86").Select 'selection de la plage de cellule ou les remplacements seront effectués
For Each feuil In ThisWorkbook.Worksheets
feuil.Cells.Replace What:=" ", Replacement:=""
Next feuil
End Sub

pour accélérer une procédure

en debut de procédure juste après le sub
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

en fin de procédure juste avant le end sub
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

cordialement
galougalou

 

[dysorthographie]

Bonjour,

Pour ce qui concerne le [-] c'est ok !

En revanche le temps de traitement est effectivement très long !

Si d'autre pouvais évalué leur solution « bancale ou pas » sur un grand nombre d’enregistrement pour le temps d’exécution .