Macro ou code VBA pour effacer des caracteres et aller a la ligne dans un meme cellule

Version imprimable

06/04/2012, 01h40
ghisunit

1 pièce(s) jointe(s)

Macro ou code VBA pour effacer des caracteres et aller a la ligne dans un meme cellule
Bonjour a tous les amis,

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

Code :
Code:

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

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:

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

[Toutes versions] Macro ou code VBA pour effacer des caracteres et aller a la ligne dans un meme cellule

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:

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

Bonsoir,

Citation:

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.

Citation:

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:

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

Bonsoir,
0.27 secondes sur 7000 lignes, en passant par des tableaux, à tester

Code:

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

Bonsoir à tous

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

Code:

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

06/04/2012, 23h01
casefayere

Bonsoir mercatog,

Citation:

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,

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:

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

07/04/2012, 09h37
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
07/04/2012, 15h29
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.