Eclatement cellule

[kaki31]

Bonsoir le forum;
Comment puis-je éclater chaque cellule de la colonne A en 03 cellules ?

voir exemple
Merci

 

[Staple1600]

Re : Eclatement cellule

Bonsoir


En utilisant Données/Convertir / Largeur Fixe

 

[kaki31]

Re : Eclatement cellule

Merci Staple1600 pour la réponse,
Pour le format des nombres comment faire?

 

[Staple1600]

Re : Eclatement cellule

Re



Essayes cette macro

Sub Macro2()
[A2].CurrentRegion.TextToColumns Destination:=Range("C2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 4), Array(6, 1), Array(37, 9), Array(45, 1))
    With Range("E2:E" & [E65536].End(xlUp).Row)
        .Replace ".", ""
        .NumberFormat = "#,##0.00"
        .TextToColumns Destination:=Range("E2")
    End With
End Sub

 

[gcoot]

Re : Eclatement cellule

Bonjour
La cellule de base étant en A6 les formules suivantes devraient fonctionner:
En C6 :
=GAUCHE(A6;6)
En D6 :
=GAUCHE(DROITE(A6;NBCAR(A6)-7);TROUVE(" ";DROITE(A6;NBCAR(A6)-7))-1)
En E6 :
=DROITE(SUPPRESPACE(A6);NBCAR(SUPPRESPACE(A6)) -TROUVE(" D ";SUPPRESPACE(A6))-2)

il y auras 2 choses à affiner : le format de la date pas beau, et puis un bug si dans le libellé il y a un " D ".

J'utilise un excel 2002. Y a t'il dans les versions + récentes une fonction type TROUVEINVERSE qui permette de chercher du texte en ordre inverse et donc de simplifier la formule et de corriger ce bug ?

Pour la date ca peut être :
=gauche(A6;2) & "/" & gauche(droite(A6;nbcar(A6)-2);2) & "/" & gauche(droite(A6;nbcar(A6)-4);2)

si des colonnes intermédiaires peuvent être ajoutées pour décomposer les formules c'est idéal d'un point de vue maintenance

 

[kaki31]

Re : Eclatement cellule

j'ai essayer la macro, ca donne rien, ou c'est moi qui ....n'est pas trop macro en macro

 

[Staple1600]

Re : Eclatement cellule

Re


J'ai testé ma macro sur ton fichier exemple

Et elle fonctionne

Voir la pièce jointe

 

[kaki31]

Re : Eclatement cellule

Merci Staple1600

 

[ROGER2327]

Re : Eclatement cellule

Bonsoir à tous

Sélectionnez les données à traiter (plage A2:A4) et exécutez la procédure :

[COLOR="DarkSlateGray"][B]Sub toto()
   With Selection
      Columns(.Cells(1, 1).Offset(0, 4).Column).Insert Shift:=xlToRight
      Application.DisplayAlerts = False
      .TextToColumns Destination:=.Cells(1, 1).Offset(0, 2), DataType:=xlFixedWidth, _
         FieldInfo:=Array(Array(0, xlDMYFormat), Array(6, 1), Array(37, 1), Array(45, 1)), _
         DecimalSeparator:=",", ThousandsSeparator:=".", TrailingMinusNumbers:=True
      Application.DisplayAlerts = True
      Columns(.Cells(1, 1).Offset(0, 4).Column).Delete Shift:=xlToLeft
   End With
End Sub[/B][/COLOR]

ROGER2327
#2682

 

[Staple1600]

Re : Eclatement cellule

Bonsoir ROGER2327



Pour ceux qui utilisent encore Excel 2000 (comme moi)

Une petite modif à faire sur le code ROGER23727

Sub toto_xl2000()
   With Selection
      Columns(.Cells(1, 1).Offset(0, 4).Column).Insert Shift:=xlToRight
      Application.DisplayAlerts = False
      .TextToColumns Destination:=.Cells(1, 1).Offset(0, 2), DataType:=xlFixedWidth, _
         FieldInfo:=Array(Array(0, xlDMYFormat), Array(6, 1), Array(37, 1), Array(45, 1)), _
         DecimalSeparator:=",", ThousandsSeparator:="."
      Application.DisplayAlerts = True
      Columns(.Cells(1, 1).Offset(0, 4).Column).Delete Shift:=xlToLeft
   End With
End Sub

 

[kjin]

Re : Eclatement cellule

Bonsoir,
Grosse annerie
Fichier modifié

Sub kaki()
For i = 2 To Range("A65000").End(xlUp).Row
    Cells(i, 1).TextToColumns Destination:=Cells(i, 3), DataType:=xlDelimited, Space:=True
    dC = Cells(i, 256).End(xlToLeft).Column
    Set plg = Range(Cells(i, 3), Cells(i, dC))
    T = Application.Transpose(plg.Value)
    plg.Clear
    Cells(i, 3) = CDate(Format(T(1, 1), "00/00/00"))
    For j = 2 To UBound(T) - 1
        If T(j, 1) <> "" Then
            Cells(i, 4) = Trim(Cells(i, 4) & " " & T(j, 1))
        End If
    Next
    Cells(i, 5) = CCur(Replace(T(UBound(T), 1), ".", ""))
Next
End Sub

A+
kjin

 

[kaki31]

Re : Eclatement cellule

Bonsoir à tous;
Les données de mon tableau ayant changées ,je reviens vers vous

Comment arriver à obtenir ceci?

Pour information: j'ai pris l'exemple de kjin

voir fichier joint
Merci

 

[kjin]

Re : Eclatement cellule

Bonjour,

Sub kaki2()
Dim tabA, tabB(), i%, j%, k%
Columns("D:J").Clear
Columns("D:E").NumberFormat = "@"
For i = 1 To Range("A65000").End(xlUp).Row
    tabA = Split(Cells(i, 1), " ")
    For j = 0 To UBound(tabA)
        If tabA(j) <> "" Then
            ReDim Preserve tabB(0 To x)
            tabB(x) = tabA(j)
            x = x + 1
        End If
    Next
    Cells(i, 4) = tabB(0)
    Cells(i, 5) = tabB(1)
    Cells(i, 6) = CDate(Format(tabB(2), "00/00/00"))
    For k = 3 To UBound(tabB) - 3
        Cells(i, 7) = Cells(i, 7) & tabB(k) & Chr(32)
    Next
    Cells(i, 7) = Left(Cells(i, 7), Len(Cells(i, 7)) - 1)
    Cells(i, 8) = tabB(UBound(tabB) - 2)
    Cells(i, 9) = CCur(Replace(tabB(UBound(tabB) - 1), ".", ""))
    Cells(i, 10) = CDate(Format(tabB(UBound(tabB)), "00/00/00"))
    x = 0
    Erase tabA
    Erase tabB
Next
Columns("D:J").AutoFit
End Sub

Voir PJ
A+
kjin