XL 2019 eclater une colonne en plusieurs pour utiliser les champs separement

jpsepe

XLDnaute Nouveau
Bonjour à tous,

je voudrais séparer une cellule globale COLONNE E qui contient plusieurs éléments sur plusieurs colonnes pour pouvoir les travailler par la suite
mais comme les lignes ne contiennent pas toutes le même nombre de caractère j'ai du mal ...

j'ai dans la colonne E des informations que je veux mettre sur plusieurs colonnes
* Achat / Vente
* Nombre
* nom de l'action
*valeur


MERCI PAR AVANCE
 

Pièces jointes

  • test actions .xlsx
    10 KB · Affichages: 17

job75

XLDnaute Barbatruc
Bonjour jpsepe,

Voyez le fichier joint et ces 2 macros affectées aux boutons :
VB:
Sub Eclater()
Dim tablo, i&, x$, j%, t1 As Boolean, t2 As Boolean
With Range("F2", Range("F" & Rows.Count).End(xlUp))
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        x = Application.Trim(tablo(i, 1)) 'SUPPRESPACE
        For j = Len(x) - 1 To 2 Step -1
            If Mid(x, j, 1) = " " Then
                t1 = IsNumeric(Mid(x, j - 1, 1))
                t2 = IsNumeric(Mid(x, j + 1, 1))
                If t1 And t2 Then
                    x = Left(x, j - 1) & Mid(x, j + 1) 'suppression
                ElseIf Not t1 And Not t2 Then
                    x = Left(x, j - 1) & Chr(160) & Mid(x, j + 1) 'remplacement
                End If
            End If
        Next j
        tablo(i, 1) = x
    Next i
    '---restitution et éclatement---
    Application.ScreenUpdating = False
    .Value = tablo
    .TextToColumns .Columns(1), xlDelimited, Space:=True, DecimalSeparator:="." 'commande Convertir
    .Resize(, 10).NumberFormat = "#,##0.00" 'format nombre
    .Resize(, 10).EntireColumn.AutoFit 'ajustement largeur
End With
End Sub

Sub RAZ()
Sheets("Mémorisation").[A:J].Copy [F1]
End Sub
Notez que j'ai interverti les colonnes E et F, c'est plus simple.

A+
 

Pièces jointes

  • test actions(1).xlsm
    22.2 KB · Affichages: 2

JHA

XLDnaute Barbatruc
Bonjour à tous,

Il y a trop d'incohérence dans le libellé.
Un début avec Power Query mais sans conviction.

Edit: Bonsoir Job75 :)
JHA
 

Pièces jointes

  • test actions (1).xlsx
    24.3 KB · Affichages: 5
Dernière édition:

job75

XLDnaute Barbatruc
Notez que j'ai interverti les colonnes E et F, c'est plus simple.
Si cependant on veut conserver le contenu de la colonne F à droite du tableau ce n'est pas très compliqué.

Dans ce fichier (2) il a suffi de modifier la fin de la macro en ajoutant un couper-coller :
VB:
Sub Eclater()
Dim tablo, i&, x$, j%, t1 As Boolean, t2 As Boolean
With Range("E1", Range("E" & Rows.Count).End(xlUp))
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        x = Application.Trim(tablo(i, 1)) 'SUPPRESPACE
        For j = Len(x) - 1 To 2 Step -1
            If Mid(x, j, 1) = " " Then
                t1 = IsNumeric(Mid(x, j - 1, 1))
                t2 = IsNumeric(Mid(x, j + 1, 1))
                If t1 And t2 Then
                    x = Left(x, j - 1) & Mid(x, j + 1) 'suppression
                ElseIf Not t1 And Not t2 Then
                    x = Left(x, j - 1) & Chr(160) & Mid(x, j + 1) 'remplacement
                End If
            End If
        Next j
        tablo(i, 1) = x
    Next i
    '---restitution et éclatement---
    Application.ScreenUpdating = False
    .Value = tablo
    .TextToColumns .Columns(3), xlDelimited, Space:=True, DecimalSeparator:="." 'commande Convertir
    Columns("F").Cut Columns(Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column + 1) 'couper-coller
    .Resize(, 10).NumberFormat = "#,##0.00" 'format nombre
    .Resize(, 10).EntireColumn.AutoFit 'ajustement largeur
    .EntireColumn.Resize(, 2).Delete 'supprime les colonnes E et F
End With
End Sub

Sub RAZ()
Sheets("Mémorisation").[A:J].Copy [E1]
End Sub
Bonsoir JHA.
 

Pièces jointes

  • test actions(2).xlsm
    23.4 KB · Affichages: 2
Dernière édition:

jpsepe

XLDnaute Nouveau
Bonjour à tous,

je voudrais séparer une cellule globale COLONNE E qui contient plusieurs éléments sur plusieurs colonnes pour pouvoir les travailler par la suite
mais comme les lignes ne contiennent pas toutes le même nombre de caractère j'ai du mal ...

j'ai dans la colonne E des informations que je veux mettre sur plusieurs colonnes
* Achat / Vente
* Nombre
* nom de l'action
*valeur


MERCI PAR AVANCE

super ...


Je vous remercie...

c est top
 

jpsepe

XLDnaute Nouveau
Si cependant on veut conserver le contenu de la colonne F à droite du tableau ce n'est pas très compliqué.

Dans ce fichier (2) il a suffi de modifier la fin de la macro en ajoutant un couper-coller :
VB:
Sub Eclater()
Dim tablo, i&, x$, j%, t1 As Boolean, t2 As Boolean
With Range("E1", Range("E" & Rows.Count).End(xlUp))
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        x = Application.Trim(tablo(i, 1)) 'SUPPRESPACE
        For j = Len(x) - 1 To 2 Step -1
            If Mid(x, j, 1) = " " Then
                t1 = IsNumeric(Mid(x, j - 1, 1))
                t2 = IsNumeric(Mid(x, j + 1, 1))
                If t1 And t2 Then
                    x = Left(x, j - 1) & Mid(x, j + 1) 'suppression
                ElseIf Not t1 And Not t2 Then
                    x = Left(x, j - 1) & Chr(160) & Mid(x, j + 1) 'remplacement
                End If
            End If
        Next j
        tablo(i, 1) = x
    Next i
    '---restitution et éclatement---
    Application.ScreenUpdating = False
    .Value = tablo
    .TextToColumns .Columns(3), xlDelimited, Space:=True, DecimalSeparator:="." 'commande Convertir
    Columns("F").Cut Columns(Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column + 1) 'couper-coller
    .Resize(, 10).NumberFormat = "#,##0.00" 'format nombre
    .Resize(, 10).EntireColumn.AutoFit 'ajustement largeur
    .EntireColumn.Resize(, 2).Delete 'supprime les colonnes E et F
End With
End Sub

Sub RAZ()
Sheets("Mémorisation").[A:J].Copy [E1]
End Sub
Bonsoir JHA.
merci !!!!!!! pour votre rapidité
 

Discussions similaires

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16