Conversion auto d'une cellule en plusieurs cellules

Bonjour à tous,

Ma question est simple :

Peut-on convertir automatiquement cette phrase :

[Celulle1]Pressez ce bouton ¤¤ afin de commencer.[\Celulle1]

en : [Celulle1]Pressez ce bouton[\Celulle1][Cellule2]¤¤[\Celulle2][Celulle3]afin de commencer.[\Celulle3]

En gros, comment puis-je faire pour dire à Excel de scinder mes cellules quand il voit des "¤¤"

Un énorme merci d'avance pour votre aide !!

Fabien

Si vous voulez savoir pourquoi :

Je travaille sur un logiciel de mise en page qui permet de récupérer des données à partir d'un fichier Excel.

Ceci me permet de créer une mise en page unique pour une notice de produit que je peux décliner en différente langues en quelques cliques. Pour cela mon fichier excel doit être correctement formaté et je rencontre un problème :

Je reçois un document excel d'une agence de traduction avec dans certaines cellules des symboles (toujours les mêmes : ¤¤). Ces symboles indiquent qu'il y a un pictogramme à l'intérieur du texte à l'endroit précis où sont placés les ¤¤.

Pour traiter correctement ces données textes, j'ai besoin de séparer le texte des symboles en plusieurs colonnes.

Voici un exemple, les crochés verts déterminent des Tag de cellule du fichier excel. Les symboles ¤¤ sont masqués grâce au logiciel de mise en page et les pictos sont ajoutés manuellement.

Bonjour FabienD, le forum

Peut-être comme ceci :

Option Explicit

Sub Splitter()
Dim a(), r As Range, e, n As Long
    ReDim a(1 To 1000, 1 To 1)
    For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
        For Each e In Split(r.Value, Chr(164) & Chr(164))
            If Trim(e) <> "" Then
                n = n + 1
                a(n, 1) = e
            End If
        Next
    Next
    With Range("a1").Offset(, 3)
        .CurrentRegion.ClearContents
        .Resize(n, 1).Value = a
    End With
End Sub

klin89

Salut Klin89,

Un collègue m'a aidé car je ne connais pas ce langage. Il a fait quelques test et a laissé des commentaires dans son code pour que tu puisses comprendre ce qui ne fonctionne pas. (Ce n'est pas un pro pro du VBA, donc peut-être que le code n'est pas super clean)

Je mets en pièce jointe le fichier excel.

En gros ton code fonctionne mais retire les symboles ¤¤. On a donc essayé de trouver un code qui garde les ¤¤ sur une ligne à part entière.

Merci beaucoup pour ton aide !!

Fabien

Re FabienD,

J'appelle ça du bricolage.

Personnellement, je passerais par le Regexp, mais je maitrise mal

A tester :

Sub Splitter1()
Dim a(), r As Range, e, n As Long, k As Long
    ReDim a(1 To 1000, 1 To 1)
    For Each r In Range("a2", Range("a" & Rows.Count).End(xlUp))
        For Each e In Split(r.Value, Chr(164) & Chr(164))
            If Trim(e) <> "" Then
                n = n + 1
                a(n, 1) = Trim(e)
                If k < UBound(Split(r.Value, Chr(164) & Chr(164))) Then
                    n = n + 1
                    a(n, 1) = Chr(164) & Chr(164)
                End If
            End If
            k = k + 1
        Next
        k = 0
    Next
    With Range("a2").Offset(, 6)
        .CurrentRegion.ClearContents
        .Resize(n, 1).Value = a
    End With
End Sub

klin89

Merci beaucoup Klin89,

Cela fonctionne parfaitement, nous sommes en train de modifier un peu le code pour pouvoir faire la manipulation sur plusieurs colonnes en même temps.

En tout cas tu nous a vraiment sortie une grosse épine du pied !

Merci beaucoup !!

Fabien

Re FabienD,

J'avais pas fini

Restitution en colonnes

Option Explicit

Sub Splitter2()
Dim a(), r As Range, e, n As Long, t As Byte, k As Byte
    ReDim a(1 To 1000, 1 To 1)
    For Each r In Range("a2", Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(r.Value) Then
            n = n + 1
            For Each e In Split(r.Value, Chr(164) & Chr(164))
                If Trim(e) <> "" Then
                    t = t + 1
                    If t > UBound(a, 2) Then
                        ReDim Preserve a(1 To 1000, 1 To t)
                    End If
                    a(n, t) = Trim(e)
                    If k < UBound(Split(r.Value, Chr(164) & Chr(164))) Then
                        t = t + 1
                        If t > UBound(a, 2) Then
                            ReDim Preserve a(1 To 1000, 1 To t)
                        End If
                        a(n, t) = Chr(164) & Chr(164)
                    End If
                    k = k + 1
                End If
            Next
            k = 0: t = 0
        End If
    Next
    'restitution à côté du tableau initial
    With Range("a2").Offset(, 6)
        .CurrentRegion.ClearContents
        .Resize(n, UBound(a, 2)).Value = a
    End With
End Sub

klin89

Merci Klin89 !!

Je vais tester tout ça

Bon nouvel an !