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

  2. michel_m Contributeur
    bonjour

    de combien est le nombre maxi (environ) de séparateurs dans une cellule?
    0
    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.
      0
      1. michel_m Contributeur
        Bonjour,

        Merci
        autre précision: combien de lignes (à peu près: 10,100,1000...)?
        0
      2. cephas_igor Auteur
        170
        0
    2. 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

      0
      2. 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
        0
        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...
          0
      3. 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"
        0
        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é ?
          0
      4. cephas_igor Auteur
        Voilà en exemple comment se présente chaque ligne:
        Rodrigue Mawafelo: Business Unit Manager CFS/RETAIL/DSD _InfoSolux
        0
        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
          0
      5. 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
        0
        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.
          0