Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…