XL 2016 Division cellules nominatives

[berlu]

Bonjour à tou.tes,

Je creuse les profondeurs des internets depuis quelques temps et je n'arrive pas à trouver mon bonheur. Comme je suis complètement ignorant de VBA, cela explique certainement beaucoup de choses...

J'ai une base de données, une colonne : NOM Prénom

Les noms en maj, avec un espace entre pour les noms composés. Tous mes prénoms commencent par une maj eux aussi. Mon objectif est de pouvoir les scinder dans deux cellules séparées. D'habitude j'arrive toujours à retomber sur mes pattes en récupérant du code de gens bien plus brillants que moi et ayant déjà répondu 1000 fois à cette question mais là je pêche.

J'ai trouvé cette fonction qui marche assez bien mais me sort un bug ligne 45 :

Sub SepareNomPrenom()
Dim i As Integer
Dim Chaine As String
Dim vASC As Integer
Dim x As Integer, y As Integer

For i = 1 To 14844
Chaine = Range("A" & i).Value
y = 1
Do
x = InStr(y, Chaine, " ")
If x > 0 Then
vASC = Asc(Mid(Chaine, x + 2, 1))
Else
vASC = 0
End If
y = x + 1
Loop Until vASC < 65 Or vASC > 90 Or x = 0
If vASC <> 0 Then
Range("B" & i).Value = Left(Chaine, x - 1)
Range("C" & i).Value = Right(Chaine, Len(Chaine) - x)
End If
Next i
End Sub

Si je comprends bien, "vASC = Asc(Mid(Chaine, x + 2, 1))" bug car cette cellule n'a pas de prénom... Je vous joins le fichier en question.

Help :/

 

[danielco]

Bonjour,

Essaie :

Sub SepareNomPrenom()
Dim i As Integer
Dim Chaine As String
Dim vASC As Integer
Dim x As Integer, y As Integer
On Error Resume Next
For i = 1 To 14844
  Chaine = Range("A" & i).Value
  y = 1
  Do
  x = InStr(y, Chaine, " ")
  vASC = 0
  If x > 0 Then
    vASC = Asc(Mid(Chaine, x + 2, 1))
  End If
  y = x + 1
  Loop Until vASC < 65 Or vASC > 90 Or x = 0
  If vASC <> 0 Then
  Range("B" & i).Value = Left(Chaine, x - 1)
  Range("C" & i).Value = Right(Chaine, Len(Chaine) - x)
  End If
Next i
On Error GoTo 0
End Sub

Cordialement.

Daniel

 

[berlu]

Bonjour,

Essaie :

Sub SepareNomPrenom()
Dim i As Integer
Dim Chaine As String
Dim vASC As Integer
Dim x As Integer, y As Integer
On Error Resume Next
For i = 1 To 14844
  Chaine = Range("A" & i).Value
  y = 1
  Do
  x = InStr(y, Chaine, " ")
  vASC = 0
  If x > 0 Then
    vASC = Asc(Mid(Chaine, x + 2, 1))
  End If
  y = x + 1
  Loop Until vASC < 65 Or vASC > 90 Or x = 0
  If vASC <> 0 Then
  Range("B" & i).Value = Left(Chaine, x - 1)
  Range("C" & i).Value = Right(Chaine, Len(Chaine) - x)
  End If
Next i
On Error GoTo 0
End Sub

Cordialement.

Daniel

Carrément magique ! Merci beaucoup !! J'ai deux ou 3 erreurs mais sur un listing de 16k je vais les prendre manuellement! Merci encore