Creation de script Résolu/Fermé

Question

Bonjour, les amis 
J'ai besoin de votre aide: 
j'aimerais écrire un script qui me permettrais d'extraire des données dans un fichier  
excel ( c'est à dire tout est enregistré dans une seule colonne sur plusieurs ligne avec des séparateurs comme : / _ ).  Je dois les extraire en tenant compte des séparateur et les ranger dans un fichier dans plusieurs colonne pour les rendre plus lisible et agréable.  
Merci de vouloir m'aider,  
Configuration: Windows 7 / Chrome 23.0.1271.97

Célien · Answer

Salut,

Je suppose que tu pourrais faire ça en VBA Excel : Tutoriels VBA Excel.

michel_m · Answer

bonjour

de combien est le nombre maxi (environ) de séparateurs dans une cellule?

cephas_igor · Answer

Bonjour, 
il y a au total 4 séparateur que je dois prendre en compte, ce sont: 
" " espace qui sépare le nom et prenom
":"  deux point qui sépare le prenom et la fonction (profession)
"_" trait de 8 qui sépare la fonction et le nom de la société
Merci.

michel_m · Answer

maquette à adapter à la disposition réelle
https://www.cjoint.com/?3LFnPJU3c1e

le code
Sub separer()
Dim Derlig As Byte, Lig As Byte
Dim T_nom, T_prenom, T_fonction

Application.ScreenUpdating = False
With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     For Lig = 2 To Derlig
          T_nom = Split(.Cells(Lig, "A"), " ")
          T_prenom = Split(T_nom(1), ":")
          T_fonction = Split(T_prenom(1), "_")
          With Sheets(2)
               .Cells(Lig, "A") = T_nom(0)
               .Cells(Lig, "B") = T_prenom(0)
               .Cells(Lig, "C") = T_fonction(0)
               .Cells(Lig, "D") = T_fonction(1)
               .Select
          End With
     Next
End With
End Sub

cephas_igor · Answer

Merci pour ton aide, 
lors de l'exécution il m'envoie un message d'erreur comme suit
"erreur 6
dépassement de capacité"
Je suis suspendu a ton aide. 
Merci

cephas_igor · Answer

Bonjour mon frère, 
je profite de l'occasion pour vous souhaiter tous mes meilleurs voeux pour cette nouvelle année 2013 et que les meilleures choses vous accompagnent par la grace de mon sauveur Jésus Christ.

Concernant le script j'ai encore un petit couac lors de la compilation pas à pas détaillé et j'ai remarqué que c'est au niveau de:
".Cells(Lig, "D") = T_fonction(1) " 
le message d'erreur est la suivante: 
"erreur d'exécution 9, l'indice n'appartient pas à la sélection"

cephas_igor · Answer

Voilà en exemple comment se présente chaque ligne:
Rodrigue Mawafelo: Business Unit Manager CFS/RETAIL/DSD _InfoSolux

michel_m · Answer

le code 
Option Explicit

Sub separer()
Dim T_in(), T_out()
Dim Lig As Integer, Derlig As Integer
Dim T_ligne, T_ident, T_fonction

Application.ScreenUpdating = False

With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     'mémorise en RAM la source
     T_in = Application.Transpose(.Range("A2:A" & Derlig))
End With

ReDim T_out(1 To UBound(T_in), 1 To 4)
'mémorise en ram les éléments séparés
For Lig = 1 To UBound(T_in)
          T_ligne = Split(T_in(Lig), ": ")
          T_ident = Split(T_ligne(0))
          T_out(Lig, 1) = T_ident(0) 'prenom
          T_out(Lig, 2) = T_ident(1) 'nom
          T_fonction = Split(T_ligne(1), "_")
          T_out(Lig, 3) = T_fonction(0) 'fonction
          T_out(Lig, 4) = T_fonction(1) 'société
Next

'restitution en feuille 2
 With Sheets(2)
     Derlig = .Columns("A").Find("", .Range("A1")).Row
     .Range("A2:D" & Derlig).ClearContents
     .Range("A2").Resize(UBound(T_out), 4) = T_out
     .Select
End With
End Sub
 
La maquette
https://www.cjoint.com/?3Acr4xJDA4T

cephas_igor · Answer

Salut Michel_m, 
franchement je ne sais te dire pour ce gros boulot tu m'as fais, juste un mot Merci.
 Voilà après quelques petites rectif sur ton programme, mon programme qui marche actuellement et qui va exactement pour mon besoin:

Sub Macro_Separer()

Dim T_in(), T_out()
Dim Lig As Integer, Derlig As Integer
Dim T_ligne, T_ident, T_fonction

Application.ScreenUpdating = False

With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     'mémorise en RAM la source
     T_in = Application.Transpose(.Range("A2:A" & Derlig))
End With

ReDim T_out(1 To UBound(T_in), 1 To 4)
'mémorise en ram les éléments séparés
For Lig = 1 To UBound(T_in)
          T_ligne = Split(T_in(Lig), ":" & " ")
          T_ident = Split(T_ligne(0))
          T_out(Lig, 1) = T_ident(0) 'prenom
          T_out(Lig, 2) = T_ident(1) 'nom
          T_fonction = Split(T_ligne(1), " " & "_")
          T_out(Lig, 3) = T_fonction(0) 'fonction
          T_out(Lig, 4) = T_fonction(1) 'société
Next

'restitution en feuille 2
 With Sheets(2)
      Derlig = .Columns("A").Find("", .Range("A1")).Row
     .Range("A2:D" & Derlig).ClearContents
     .Range("A2").Resize(UBound(T_out), 4) = T_out
     .Select
End With

End Sub

Une fois encore merci.