Extraction d'une chaine de caractères VBA

Sylvain59

XLDnaute Occasionnel
Dans le fichier joint j'extrai le nom et prénom de la colone A avec une formule

mais elle risque d'être tres lourde car la colone A aura plusieurs centaines de lignes

quelqu'un saurait-il faire la même chose mais avec un code VBA car cela dépasse mes compétences dans ce dommaine:confused:

Merci d'avance aux bonnes volontés:)
 

Sylvain59

XLDnaute Occasionnel
Re : Extraction d'une chaine de caractères VBA

Pour Hasco

Le post d'aujourd'hui ne me convient pas car j'ai des noms composés avc ou sans - idem pour les prénoms

ma formule part à partir du / des dates car là j'ai toujours le même nombre de caractères à gauche
 

Roland_M

XLDnaute Barbatruc
Re : Extraction d'une chaine de caractères VBA

re:

voir modif avec button et macro pour traiter les noms

Roland
 

Pièces jointes

  • extraction(1).xls
    34.5 KB · Affichages: 332
  • extraction(1).xls
    34.5 KB · Affichages: 340
  • extraction(1).xls
    34.5 KB · Affichages: 346

jp14

XLDnaute Barbatruc
Re : Extraction d'une chaine de caractères VBA

Bonsoir

Ci dessous une macro
Code:
Sub travdemande()
Dim i As Long
Dim lidep1 As Long
Dim nomfeuille1 As String
Dim col1 As String
Dim cellule As Range
lidep1 = 4
nomfeuille1 = ActiveSheet.Name

col1 = "a"
With Sheets(nomfeuille1)

    For Each cellule In .Range(col2 & lidep1 & ":" & col2 & .Range(col2 & "65536").End(xlUp).Row)
        For i = 1 To Len(cellule.Value)
            If IsNumeric(Mid(cellule, i, 1)) Then Exit For
        Next i
        nom1 = Trim(Mid(cellule, 1, i - 1))
        pos = InStr(1, nom1, " ")
        nom2 = Trim(Mid(nom1, 1, pos - 1))
        prenom = Trim(Mid(nom1, pos + 1, 50))
        cellule.Offset(0, 2).Value = nom2 & " " & prenom ' à modifier
     
    Next cellule
End With
End Sub

A tester

JP
 

pierrejean

XLDnaute Barbatruc
Re : Extraction d'une chaine de caractères VBA

bonsoir a tous

encore une !!

Code:
Sub test()
Dim m As Integer
Dim n As Integer
Dim x
Columns(3).ClearContents
For n = 4 To Range("A65536").End(xlUp).Row
 x = Split(Range("A" & n), " ")
 If UBound(x) - 2 > 0 Then
  For m = 0 To UBound(x) - 2
    Range("C" & n) = Range("C" & n) & " " & x(m)
  Next m
 End If
Next n
End Sub
 

Pièces jointes

  • extraction.zip
    3.1 KB · Affichages: 158
  • extraction.zip
    3.1 KB · Affichages: 175
  • extraction.zip
    3.1 KB · Affichages: 176

Discussions similaires

Statistiques des forums

Discussions
312 535
Messages
2 089 387
Membres
104 154
dernier inscrit
Patou