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

[casefayere]

Bonsoir mercatog,

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

Bien sur, tu as mon consentement et je me fais toujours plaisir à regarder toutes tes accommodations formatrices (même si je ne te réponds pas toujours, quand tu interviens)

Bonne fin de soirée

Cordialement,

[BlueMonkey]

Bonjour,

Le code le plus rapide est effectivement le dernier posté par Mercatog basé sur des tableaux (idée de Casefayere)

Sinon un code moins rapide (~1,2 sec pour 5000 lignes), mais sans variable ni tableau.

Code :

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

1
2
3
4
5
6
7
8
Sub TransformeColEenColD()
    Application.ScreenUpdating = False
    Range("E2:E" & Range("E2").End(xlDown).Row).Copy
    Range("D2").PasteSpecial (xlPasteValues)
    Selection.Replace What:=";#*;#", Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows
    Selection.Replace What:=";#*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
    Application.ScreenUpdating = True
End Sub

[casefayere]

re le forum, bonjour ghisunit, mercatog, BlueMonkey

Je me suis permis de te donner 1 point pour l'originalité de la méthode, BlueMonkey, maintenant ghisunit a le choix, utiliser les tableaux ou les éviter, mais je trouve pédagogique de les utiliser afin de les maitriser pour de futurs projets.

Bonne journée à tou(te)s

[BlueMonkey]

Re.

Merci pour les encouragements.
Pour info j'ai également soutenu la méthode basé sur les tableaux (car sensiblement plus rapide).
Je suis également d'accord sur l'aspect formateur de l'utilisation la méthode.

Bonne après-midi

P.S:
A titre plus personnel j'utilise la philosophie du code le plus court, et le plus clair possible à lire.
Tout simplement pour des raisons de maintenance du code dans le temps. (c'est parfois difficile de se remettre dans un code très optimisé)
Donc si les performances sont raisonnables par rapport à mes attentes, je choisir toujours le code le plus clair et le plus court.

Il n'y a pas de bonne solution universelle à un problème. La meilleure solution est celle qui est la plus adaptée au contexte.