Discussion :

[ghisunit]

Bonjour a tous les amis,

J'ai utilise la formule suivante que l'on m'a gentillement explique sur ce super site:

Code :

Code :

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

1
2
3
4
Function remove_aprespointvirgule(Rng As Range)
    Application.Volatile
    remove_aprespointvirgule= Left(Rng.Value, InStr(Rng.Value, ";")-1)
End Function

Qui me permet de supprimer tous les caractères après le ; (point virgule) dans toute ma colonne A.

A | B
Aer12 |Aer12;#17
Aer12 |Aer12;#17
Aer12 |Aer12;#17
All Program |All Program;#14
All Program |All Program;#14
All Program |All Program;#14

Mais en fait, je souhaiterai mettre en place une autre Macro ou en VBA pour faire quelque chose d'un peu plus complexe.

L’idée est de retirer tous les caractères inutile de la colonne E dans la colonne D.
Autrement dit de retirer les point virgules
les # ainsi que les chiffres entre ;#1;
Puis enfin de faire un retour a la ligne dans la même cellule.

Comme cela:

D |E

Aer12
Ber12
Ghi41 |Aer12;#1;Ber12;#2;Ghi41;#5

Aer12
Ber12 |Aer12;#1;Ber12;#2

Aer12
Ber12
Ghi41 |Aer12;#1;Ber12;#2;Ghi41;#5

Aer12
Ber12 |Aer12;#1;Ber12;#2

Aer12
Ber12
Ghi41 |Aer12;#1;Ber12;#2;Ghi41;#5

All Program
Aer12
Ber12
Ghi41 |All Program;#14;Aer12;#1;Ber12;#2;Ghi41;#5

All Program
Ber12
Ghi41 |All Program;#14;Ber12;#2;Ghi41;#5



J'ai mi le fichier Excel si ça peut aider.
N'hesiter pas a me dire si ma demande n'est pas claire.
Merci d'avance pour votre aide les amis.

Ciao

Ghis

[BlueMonkey]

Bonjour,

En transformant la chaîne de caractère contenant les ; en tableau de chaîne (avec la fonction split),
puis en utilisant une valeur de ce tableau sur 2 concaténé avec "\r\n" (pour les retours à la ligne) on obtient ça :

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
Sub TransformeColEenColD()
 
    Dim r As Range
    Dim vals() As String
 
    For Each r In Range("E1:E" & Range("E1").End(xlDown).Row)
        vals = Split(r.Value, ";")
        Dim i As Integer
 
        With r.Offset(0, -1)
            .Value = ""
 
            For i = 0 To UBound(vals) Step 2
                .Value = IIf(i + 1 < UBound(vals), .Value & vals(i) & Chr$(10) & Chr$(13), .Value & vals(i))
            Next i
 
        End With
 
    Next r
 
End Sub

[ghisunit]

Merci beaucoup BlueMonkey.

J'ai essaye ton code celui ci fonctionne bien
J'ai juste ajouter le caractere # en rouge car en fait ma cellule a mettre en forme est de la forme suivante:

D |E

Aer12
Ber12
Ghi41 |Aer12;#1;#Ber12;#2;#Ghi41;#5

Les deux seul problemes que j'ai;

-c'est que j'ai un caractère de saut ligne qui s'affiche dans ma colonne D qui ressemble a ça: [?]

- Puis en fait mon fichier fait près de 2000 lignes par conséquent la macro met au moins 1 minute pour mettre en forme toutes les cellules de la colonnes D.

Par conséquent est-il possible de passer par une function a la place d'une macro (Sub)?

Merci d'avance pour votre aide les amis

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
Sub TransformeColEenColD()
 
    Dim r As Range
    Dim vals() As String
 
    For Each r In Range("E1:E" & Range("E1").End(xlDown).Row)
        vals = Split(r.Value, ";#")
        Dim i As Integer
 
        With r.Offset(0, -1)
            .Value = ""
 
            For i = 0 To UBound(vals) Step 2
                .Value = IIf(i + 1 < UBound(vals), .Value & vals(i) & Chr$(10) & Chr$(13), .Value & vals(i))
            Next i
 
        End With
 
    Next r
 
End Sub

[BlueMonkey]

Bonsoir,

Les deux seul problemes que j'ai;
-c'est que j'ai un caractère de saut ligne qui s'affiche dans ma colonne D qui ressemble a ça: [?]

Dans le code suivant, je remplace le saut de ligne \r\n par un simple \n.

Puis en fait mon fichier fait près de 2000 lignes par conséquent la macro met au moins 1 minute

Pour 2000 lignes, en modifiant un peu le code, j'arrive à 2 sec.

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
Sub TransformeColEenColD()
    Dim r As Range
    Dim vals() As String
    Dim i As Integer
    Dim res As String
    Dim Cr As String
    Cr = Chr$(10)
 
    Application.ScreenUpdating = False
 
    For Each r In Range("E2:E" & Range("E2").End(xlDown).Row)
        vals = Split(r.Value, ";#")
        res = vals(0)
 
            For i = 2 To UBound(vals) Step 2
                res = res & Cr & vals(i)
            Next i
 
         r.Offset(0, -1).Value = res
 
    Next r
 
    Application.ScreenUpdating = False
 
End Sub

[casefayere]

Bonsoir,
0.27 secondes sur 7000 lignes, en passant par des tableaux, à 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
Sub TransformeColEenColD()
Dim r As Long, montb As Variant, tb2(), Derlg As Long, t1, t2
Dim vals() As String, i As Integer, x As Integer
x = 1
t1 = Timer
Derlg = Range("E1").End(xlDown).Row
'ou
'Derlg = Range("E" & Rows.Count).End(xlUp).Row
montb = Range("E1:E" & Derlg).Value
For r = 1 To UBound(montb)
  ReDim Preserve tb2(1 To r)
  vals = Split(montb(r, 1), ";")
    For i = 0 To UBound(vals) Step 2
      If tb2(r) = "" Then
        tb2(r) = vals(i)
      Else
        tb2(r) = tb2(r) & Chr(10) & vals(i)
      End If
    Next i
Next r
Range("D1:d" & Derlg) = WorksheetFunction.Transpose(tb2)
t2 = Timer
MsgBox t2 - t1
End Sub

[mercatog]

Bonsoir à tous

Ci-après une petite modification sur le code de Dominique utilisant une unique variable tableau (avec son consentement je suppose)

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
Sub TransformeColEenColD()
Dim DerLg As Long, r As Long, T1 As Long
Dim Vals() As String
Dim monTb As Variant
Dim i As Integer
 
Application.ScreenUpdating = False
T1 = Timer
With Worksheets("Sheet1")
    DerLg = .Range("E" & .Rows.Count).End(xlUp).Row
    monTb = .Range("D1:E" & DerLg).Value
    For r = 1 To UBound(monTb, 1)
        Vals = Split(monTb(r, 2), ";")
        monTb(r, 1) = Vals(0)
        For i = 2 To UBound(Vals) Step 2
            monTb(r, 1) = monTb(r, 1) & Chr(10) & Vals(i)
        Next i
    Next r
    .Range("D1:E" & DerLg) = monTb
End With
MsgBox Timer - T1
End Sub