Creation de script

Résolu
cephas_igor -  
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,

9 réponses

  1.  cephas_igor Auteur
    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.
    1. michel_m Contributeur
      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
      1. cephas_igor Auteur
        Voilà en exemple comment se présente chaque ligne:
        Rodrigue Mawafelo: Business Unit Manager CFS/RETAIL/DSD _InfoSolux
        1. michel_m Contributeur
          hé oui! tu m'avais pas dit que la séparation était un espace suivi d'un signe pour le _ et : suivi d'un espace
          d'autre part la fonction comporte des espaces....

          bref! c'est un tout autre problème....

          sois patient, pour l'instant je n'ai pas d'idées
      2. cephas_igor Auteur
        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"
        1. michel_m Contributeur
          bonjour,
          Curieux, je viens dé ré-essayer sur la maquette et je n'ai pas ce problème!
          as tu un "souligné" _ entre la fonction et la société ?
      4. cephas_igor Auteur
        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
        1. michel_m Contributeur
          Tu m'avais dit 170 lignes...
          remplace
          Dim Derlig As Byte, Lig As Byte
          par
          Dim Derlig As Integer, Lig As integer

          si tu as beaucoup de lignes, il faudrait utiliser une méthode + rapide
          tu dis...
      5. michel_m Contributeur
        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

        1.  cephas_igor Auteur
          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.
          1. michel_m Contributeur
            Bonjour,

            Merci
            autre précision: combien de lignes (à peu près: 10,100,1000...)?
          2. cephas_igor Auteur
            170
        2. michel_m Contributeur
          bonjour

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