Discussion :

[gfvsdtut]

Bonjour,

Je dois faire une macro mais je bloque sur la boucle Split, je n'arrive pas à récupérer la valeur retour
Ma macro :
Elle va trier une liste de données dans un onglet LIST - OK
Elle va ensuite chercher dans l'onglet REC une liste de données (toutes dans la colonne A)
Ces données je les nettoie (j'enlève les espaces insécables ou non) - OK
je récupère la taille de ma liste de données - car elle peut être variable - OK

et je dois faire un split pour récupérer les données - C'est là que cela coince.

pour faire un VLookup derrière - pas encore travaillé

Mon souci est que je veux mettre les données du split dans un nouvel onglet RESULT pour pouvoir les travailler sur le VLookup et surtout garder une trace pour vérifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Option Explicit
Sub macro_tri()
    With Worksheets("LIST")
        .UsedRange.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
    End With
End Sub
 
Sub extractionMots()
    Dim Tableau() As String
    Dim i As Integer
    Dim NbLignes As Integer             ' pour récupérer le nombre de lignes à traiter
    Dim ws As Worksheet                 ' pour désigner la feuille de travail
    Dim TextSoc As String
    Dim refSoc As Variant
    Dim cpt As Range
    Dim newLine As Range
    Dim rng As Range
 
    Set ws = Worksheets("REC")
    ws.Activate
 
    ' Enlève les espaces et le char 160 - espace insécable
    Sheets("REC").Columns(1).Replace " ", ""
    Sheets("REC").Columns(1).Replace Chr(160), ""
 
    NbLignes = ActiveSheet.UsedRange.Rows.Count
    Set rng = Range("A1:A" & NbLignes)
    i = 1
    For Each cpt In rng
        TextSoc = cpt.Value
        refSoc = Split(TextSoc, "|")
        For Each newLine In refSoc
            Sheets("RESULT").Cells("A", i) = newLine
            i = i + 1
        Next newLine
        cpt = cpt + 1
    Next cpt
    Set ws = Nothing
End Sub
 
 
Sub macro_main()
   macro_tri
   extractionMots
End Sub

Par avance merci pour tout aide.

[Invité]

Bonjour,

Une solution parmi d'autres à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Option Explicit
 
Sub ExtractionMots()
 
Dim I As Long, J As Long, NbLignes As Long
Dim Ws As Worksheet
Dim RefSoc As Variant
Dim Rng As Range, Cpt As Range
 
    With Sheets("RESULT")
         .Columns(1).ClearContents
    End With
 
    Set Ws = Sheets("REC")
    With Ws
 
         ' Enlève les espaces et le char 160 - espace insécable
         .Columns(1).Replace " ", ""
         .Columns(1).Replace Chr(160), ""
 
          NbLignes = .Cells(.Rows.Count, 1).End(xlUp).Row
          Set Rng = .Range("A1:A" & NbLignes)
 
          I = 1
          For Each Cpt In Rng
              RefSoc = Split(Cpt.Value, "|")
              For J = LBound(RefSoc, 1) To UBound(RefSoc, 1)
                  Sheets("RESULT").Cells(I, 1) = RefSoc(J)
                  I = I + 1
              Next J
        Next Cpt
 
    End With
    Set Ws = Nothing
 
End Sub

[gfvsdtut]

Bonjour Eric,

merci de ta réponse, j'essaie cela dans la journée.
J'ai juste adapté pour que le Split se fasse sur plusieurs colonnes (une colonne par ligne lue)
Mille mercis.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
Sub ExtractionMots()
 
Dim I As Long, J As Long, NbLignes As Long
Dim Ws As Worksheet
Dim RefSoc As Variant
Dim Rng As Range, Cpt As Range
 
    With Sheets("RESULT")
         Cells.ClearContents
    End With
 
    Set Ws = Sheets("REC")
    With Ws
 
         ' Enlève les espaces et le char 160 - espace insécable
         .Columns(1).Replace " ", ""
         .Columns(1).Replace Chr(160), ""
 
          NbLignes = .Cells(.Rows.Count, 1).End(xlUp).Row
          Set Rng = .Range("A1:A" & NbLignes)
 
          I = 1
          J = 1
          For Each Cpt In Rng
              RefSoc = Split(Cpt.Value, "|")
              For K = LBound(RefSoc, 1) To UBound(RefSoc, 1)
                  Sheets("RESULT").Cells(I, J) = RefSoc(K)
                  I = I + 1
              Next K
              J = J + 1
              I = 1
         Next Cpt
     End With
  End Sub