Discussion :

[Maxime VANDEPLASSCHE]

Bonjour

Je travaille sur un code permettant l'extraction (le split) des donnees d'un champs. Le code fonctionne mais il y a certaines erreurs que je n'arrive a corriger.
LE fichier excel est construit comme cela:
- Feuille 'Input' comprenant en colonne C 'Basic Data' le champs que je souhaite extraire + 2 boutons (Macro pour generer, et Clean pour retirer les donnees)
- Feuille 'Output' Colonne A --> Material reference, Col B --> Sequence Nb, Col C --> Les champs splittes
- Feuille 'Back-up' --> Feuille cree manuellement qui reprend les informations de la feuille 'Output' et a laquelle je souhaite ajouter 3 formules automatiquement via le code sur le la feuille 'Output'

Pour resumer,
Le code fonctionne pour le split --> Cependant, cela genere a partir de la premiere ligne (les en-tete) de la feuille 'Input'. Dans l'ideal, generer a partir de la seconde ligne
Qund le code genere, il y a des infos en colonne D de la feuille Input qui se cree, j'aimerais que ces donnees n apparaissent pas
Les 3 formules ne sont pas operationnelles via le VBA (exemple dans le code ou formules excel de la feuille Back-Up)
Et si on peut en meme temps ameliorer la mise en page (column Width) pour ajuster la longueur des colonnes, ce serait parfait.

Merci pour votre aide
SPLIT_CELL.xlsm

Voici le code a l instant t

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
47
48
49
Sub Split_Cell()
 Dim nbcar_init, nbcar_end, Nb_int, Nb_space, j, k, a, b, z, y, r As Long
 Dim i As Long
 Dim cell_interm As String
 LastRow = ThisWorkbook.Sheets("Output").Cells(Rows.Count, 2).End(xlUp).Row
 j = 1
 k = 0
 a = 1
 z = 1
 y = 10
 r = 2
 While Cells(a, 3) <> ""
    Cells(a, 4) = Cells(a, 3) & Chr(10)
    a = a + 1
 Wend
 'Columns("C:C").Delete Shift:=xlToLeft
 ThisWorkbook.Sheets("Output").Range("A1:E" & LastRow).ClearContents
    While Cells(j, 3) <> ""
        nbcar_init = Len(Cells(j, 3)) ' BASIC DATA
        nbcar_end = Len(Replace(Cells(j, 3), Chr(10), ""))
        Nb_space = (nbcar_init - nbcar_end)
    cell_interm = Cells(j, 3)
 
    i = 2
    For i = (1 + k) To (Nb_space + k)
 
        Sheets("Output").Cells(i, 1) = Sheets("Input").Cells(z, 1) ' Column 1
        Sheets("Output").Cells(i, 2) = y 'Column 2
        Sheets("Output").Cells(i, 3) = Left(cell_interm, InStr(1, cell_interm, Chr(10))) 'Column 3
        Nb_int = Len(cell_interm) - InStr(1, cell_interm, Chr(10))
        cell_interm = Right(cell_interm, Nb_int)
        y = y + 10
 
        'ICI
       'Sheets("Output").Cells(i, 4).Formula = "=RIGHT(RC[-2],LEN(RC[-2])-SEARCH("":"",RC[-2],1))" 'COLONNE E
       'Sheets("Output").Cells(i, 5).Formula = "=TRIM(RC[-1])" 'COLONNE F
        'Sheets("Output").Cells(i, 6).Formula = "=RC[-6]&""/""&RC[-5]" 'COLONNE G
 
 
    Next
     j = j + 1
     k = k + Nb_space
     z = z + 1
     y = 10
     i = i + 1
    Wend
 
'Columns("C:C").Delete Shift:=xlToLeft
End Sub

[EricDgn]

Bonjour,

Un début de solution, à adapter, utilisant la fonction Split() pour obtenir chacune des lignes:

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
Option Explicit
 
Sub CleanUpColumnC()
    Dim kR As Long, s As String
    ThisWorkbook.Worksheets("Input").Select
    kR = 1
    While Cells(kR, 1) <> ""
        s = Trim(Cells(kR, 3))              '--- supprime les espaces devant et derrière
        s = Replace(s, vbLf & vbLf, "")     '--- supprime les doubles sauts de ligne
        If Asc(Right(s, 1)) = 10 Then
            s = Left(s, Len(s) - 1)         '--- supprime le dernier saut de ligne
        End If
        If Asc(Left(s, 1)) = 10 Then
            s = Mid(s, 2)                   '--- supprime le premier saut de ligne
        End If
        Cells(kR, 3) = s
        kR = kR + 1
    Wend
End Sub
 
Sub Split_Cell()
    Dim kRi As Long, kRo As Long, arrBD() As String, i As Long, k As Long
    CleanUpColumnC
    ThisWorkbook.Sheets("Output").Cells.ClearContents       '--- Clear Output
    ThisWorkbook.Worksheets("Input").Select
    kRi = 2
    kRo = 2
    With ThisWorkbook.Worksheets("Output")
        While Cells(kRi, 1) <> ""
            arrBD = Split(Cells(kRi, 3), vbLf)              '--- split
            For i = 0 To UBound(arrBD)
                .Cells(kRo, 1) = Cells(kRi, 1)
                .Cells(kRo, 2) = 10 * (i + 1)
                .Cells(kRo, 3) = arrBD(i)
                k = InStr(arrBD(i), ":")
                .Cells(kRo, 4) = Left(arrBD(i), k - 1)
                .Cells(kRo, 5) = Trim(Mid(arrBD(i), k + 1))
                .Cells(kRo, 6) = .Cells(kRo, 1) & "/" & .Cells(kRo, 2)
                kRo = kRo + 1
            Next i
            kRi = kRi + 1
        Wend
    End With
End Sub

Cordialement.

[Maxime VANDEPLASSCHE]

Bonjour,

Un début de solution, à adapter, utilisant la fonction Split() pour obtenir chacune des lignes:

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
Option Explicit
 
Sub CleanUpColumnC()
    Dim kR As Long, s As String
    ThisWorkbook.Worksheets("Input").Select
    kR = 1
    While Cells(kR, 1) <> ""
        s = Trim(Cells(kR, 3))              '--- supprime les espaces devant et derrière
        s = Replace(s, vbLf & vbLf, "")     '--- supprime les doubles sauts de ligne
        If Asc(Right(s, 1)) = 10 Then
            s = Left(s, Len(s) - 1)         '--- supprime le dernier saut de ligne
        End If
        If Asc(Left(s, 1)) = 10 Then
            s = Mid(s, 2)                   '--- supprime le premier saut de ligne
        End If
        Cells(kR, 3) = s
        kR = kR + 1
    Wend
End Sub
 
Sub Split_Cell()
    Dim kRi As Long, kRo As Long, arrBD() As String, i As Long, k As Long
    CleanUpColumnC
    ThisWorkbook.Sheets("Output").Cells.ClearContents       '--- Clear Output
    ThisWorkbook.Worksheets("Input").Select
    kRi = 2
    kRo = 2
    With ThisWorkbook.Worksheets("Output")
        While Cells(kRi, 1) <> ""
            arrBD = Split(Cells(kRi, 3), vbLf)              '--- split
            For i = 0 To UBound(arrBD)
                .Cells(kRo, 1) = Cells(kRi, 1)
                .Cells(kRo, 2) = 10 * (i + 1)
                .Cells(kRo, 3) = arrBD(i)
                k = InStr(arrBD(i), ":")
                .Cells(kRo, 4) = Left(arrBD(i), k - 1)
                .Cells(kRo, 5) = Trim(Mid(arrBD(i), k + 1))
                .Cells(kRo, 6) = .Cells(kRo, 1) & "/" & .Cells(kRo, 2)
                kRo = kRo + 1
            Next i
            kRi = kRi + 1
        Wend
    End With
End Sub

Cordialement.