Eclatement cellule

[kaki31]

Bonjour;
En macro, comment éclater les cellules de A1 à A6 en plusieurs cellules avec les formats indiquées ?

Un sujet semblable a été résolu,mais comme je suis micro en macro 😱

https://www.excel-downloads.com/threads/eclatement-cellule.135793/

Merci.🙂

 

[C@thy]

Re : Eclatement cellule

As-tu essayé données/Convertir?

C@thy

 

[kaki31]

Re : Eclatement cellule

Bonsoir C@thy

Oui j'ai déjà essayé , mais je suis intéressé par un truc genre post #7 du lien que j'ai donné (macro) c'est plus pratique je crois.

Merci

 

[Staple1600]

Re : Eclatement cellule

Bonsoir

Pour le fun et parce que cela fonctionne avec Données/Convertir et l’enregistreur de macros
(C'est pas du code VBA joli, joli mais il fait ce qu'on lui demande) 😉

Sub MacroavecDonneesConvertir()
'on prépare le terrain
Application.ScreenUpdating = False
With Range("B1:B6")
    .FormulaR1C1 = "=TRIM(RC[-1])"
    .Value = .Value
    End With
Columns("A:A").Delete

Range("A1:A6").Replace What:=" M ", Replacement:="$M$", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Range("A1:A6").Replace What:=" P ", Replacement:="$P$", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

'On se donne et on se convertit
'une fois
Range("A1:A6").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
        OtherChar:="$", FieldInfo:=Array(Array(0, 2), Array(17, 9)), _
        TrailingMinusNumbers:=True
'deux fois
Range("B1:B6").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
        :="$", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 4)), _
        TrailingMinusNumbers:=True
'trois fois
Range("A1:A6").TextToColumns Destination:=Range("E1"), DataType:=xlFixedWidth, _
        OtherChar:="$", FieldInfo:=Array(Array(0, 9), Array(18, 2)), _
        TrailingMinusNumbers:=True
'quatre fois
Range("E1:E6").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="$", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1)), _
        ThousandsSeparator:=".", TrailingMinusNumbers:=True
    Range("G1:G6").TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
        :="$", FieldInfo:=Array(Array(1, 1), Array(2, 4)), ThousandsSeparator:=".", _
        TrailingMinusNumbers:=True
'c'est fini
Range("B1:H6").Columns.AutoFit
Range("B1:H6").Borders.LineStyle = xlContinuous
Application.ScreenUpdating = False
End Sub

 

[kaki31]

Re : Eclatement cellule

Bonsoir Staple1600

Je crois que ça cloche quelque part,une fois le bouton enfoncer la conversion ce fait ,mais le bouton disparait.

Merci.

 

[Staple1600]

Re : Eclatement cellule

Re

J'ai testé avant de poster (et sur mon PC cela fonctionne mais j'ai lancé la macro par Outils/Macros pas par les biais d'un bouton)

(voir copie d'écran ci-dessous)

 

[kaki31]

Re : Eclatement cellule

Re
Oui c'est bien ça,mais n’y a t-il pas un moyen de faire via bouton
Merci

 

[Staple1600]

Re : Eclatement cellule

re

je viens de tester en affectant la macro à ton accolade et en cochant : Ne pas déplacer ou dimensionner avec les cellules
et cela fonctionne.

 

[JCGL]

Re : Eclatement cellule

Bonjour à tous

Modifie les propriétés du bouton...

A+ à tous

 

[kaki31]

Re : Eclatement cellule

c'est OK
Merci.