Modifier et substituer des caractères dans une chaîne

Bonjour,

J'ai actuellement dans une colonne des valeurs (en mm) de type par exemple :

600/600/10

Ce que je cherche à faire, c'est à obtenir dans une autre colonne les valeurs suivantes (en cm) :

60x60x1

Ce qui complique un peu les choses, c'est que parfois j'ai dans ma colonne une valeur telle que 300/600

J'ai essayé plusieurs chose avec substitue et gauche nbcar, mais sans succès...

Cela peut être du vba ou une formule. Je remercie par avance toute personne qui pourra m'apporter son aide.

Bonjour,

Bon je voulais transposer un tableau final sans passer par 3 tableaux et coller mes valeurs une a une mais je n'y arrive pas donc :

Sub TRANSFO()
Dim TABLE_T As Variant, TABLE_F(), L%
L = 1
With ActiveSheet
    Do
        TABLE_T = Split(.Cells(L, 1), "/")
        For C = 0 To UBound(TABLE_T)
            TABLE_T(C) = CInt(TABLE_T(C)) / 10
        Next C
    .Cells(L, 1) = Join(TABLE_T, "x")
    L = L + 1
    Loop Until .Cells(L, 1) = ""
End With
End Sub

Probablement possible de l'avoir aussi par fonction personnalisé mais je ne maîtrise pas la méthode ..

Si ça ne correspond pas merci de joindre un fichier représentatif.

Cdlt,

Edit : Je savais exactement que tu allais passer par ici 3GB, c'est un sujet qui te correspond tout à fait, je voyais même déjà ta réponse !

Bonjour,

Voici une proposition avec une fonction personnalisée :

function ConvertirCm(chaine$)
t = split(chaine, "/")
for i = lbound(t) to ubound(t)
    t(i) = t(i) / 10
next i
ConvertirCm = join(t, "x")
end function

à utiliser ainsi sur feuille :

=ConvertirCm(A1)

Cdlt,

Edit : Tu vois l'avenir Ergotamine

Bonjour,

si les valeurs sont en colonne A et commencent en A2, en B2 mettez la formule suivante:

=CONVERTir(A2)

c'est une fonction personnalisée, dont voici le code:

Function Convertir(Plage As String) As String
    Dim Texte As String, i As Long, Cm
    Plage = " " & Replace(Plage, "/", " ") & " "
    Texte = ""
    Cm = Split(Plage, " ")
    For i = 1 To UBound(Cm) - 1
        Texte = Texte & " x " & CDbl(Cm(i) / 10)
    Next
   Convertir = Right(Texte, Len(Texte) - 2)
End Function

Edit : j'arrive trop tard, nos messages se sont croisés

Bonjour,

Merci beaucoup à vous trois ! C'est brillantissime !

J'aime particulièrement la fonction de 3GB

Merci à vous et belle journée.

Sandra

Bonjour à tous,

Seulement pour le fun... et parce que j'aime raccourcir les formules. Cela me rappelle un défi.

Function Cm(str$)
str = Replace(str & "/", "0/", "x")
Cm = Left(str, Len(str) - 1)
End Function

Salut X Cellus,

C'est une belle solution (...de filou^^) ! En parlant de défi, à quand la suite alors ?

On m'a rien demandé mais voici une surenchère à ma proposition initiale afin de la rendre plus générale :

'pour convertir chaque dimension à la puissance renseignée en second argument
Function Convertir(chaine$, Optional dizaine% = 1, Optional before$ = "/", Optional after$ = "x")
t = Split(chaine, before)
For i = LBound(t) To UBound(t)
    t(i) = NVal(CStr(t(i))) / 10 ^ dizaine
Next i
Convertir = Join(t, after)
End Function

'pour ne conserver que les nombres et virgules
Function NVal(chaine$)
For i = 1 To Len(chaine)
    If Not Mid(chaine, i, 1) Like "[0-9,]" Then Mid(chaine, i, 1) = " "
Next i
NVal = Replace(chaine, " ", "")
End Function

A plus,

Bonjour à vous,

Magnifique vos surenchères !

Juste un petit problème avec la fonction de X Cellus. Si on a les valeurs 750/150/12 ou 300/600/9 il y a une mauvaise conversion de la dernière mesure si ce n'est pas une dizaine. Exact ?

Ma préférée est encore celle de 3GB !

Puis-je encore vous demander une petite fonction ?

Et si sur des mesures telles que 600/600/10 pour avoir 60x60 ou 300/600/9 pour avoir 30x60 ? Est-ce que ce serait aussi possible ?

Pour l'instant, je parviens à le faire avec la formule suivante (si la valeur est en A2) :

=CONCATENER(GAUCHE(A2;CHERCHE("/";A2)-1)/10;"x";STXT(A2;CHERCHE("/";A2;1)+1;CHERCHE("/";A2;CHERCHE("/";A2;1)+1)-(CHERCHE("/";A2;1)+1))*1/10;" cm")

Merci à vous grandement si vous pouvez m'apporter votre aide encore une fois.

Sandra

Bonsoir SandraPf,

En effet, X Cellus a "arrondi les angles" pour que le code soit plus court car la concision était l'objet d'un défi lancé récemment par X Cellus même...

Pour cette nouvelle fonction, c'est moins clair car je n'ai pas idée des cas possibles... Je vais donc supposer que ça porte uniquement sur la dernière dimension, lorsqu'elle est à +-0,1 cm de 1 :

function FixDimensions(chaine$)
t = split(chaine, "x")
if ubound(t) < 2 then FixDimensions = chaine: exit function
redim temp(ubound(t))
for i = lbound(t) to ubound(t): temp(i) = t(i): next i
if abs(t(2) - 1) > 0.1 then redim preserve temp(1)
FixDimensions = join(temp, "x")
end function

Il faut l'imbriquer avec la précédente :

=FixDimensions(Convertir(A1))

C'est à voir mais ce n'est pas vraiment une fonction sûre.

Cdlt,

Bonjour 3GB,

Un grand merci pour ces explications et cette nouvelle fonction. C'est beau de maîtriser cela !

Comme la troisième dimension "mesure" devrait être ignorée dans tous les cas lors de la conversion en cm, j'ai simplement modifié ta fonction en enlevant la condition. Ce qui donne :

Function FixDimensions(chaine$)
t = Split(chaine, "x")
If UBound(t) < 2 Then FixDimensions = chaine: Exit Function
ReDim temp(UBound(t))
For i = LBound(t) To UBound(t): temp(i) = t(i): Next i
ReDim Preserve temp(1)
FixDimensions = Join(temp, "x")
End Function

Dans ce cas, ta fonction devient sûre, n'est-ce pas ?

Encore merci de ton aide.

Sandra

Bonjour,

Ah oui, dans ce cas, il n'y a pas besoin de se préoccuper des éventuels cas particuliers :

Function FixDimensions(chaine$)
if not chaine like "*x*x*" then
    FixDimensions = chaine
else
    t = Split(chaine, "x")
    FixDimensions = t(0) & "x" & t(1)
end if
End Function

Cdlt,

Bonjour 3GB,

Merci beaucoup et bonne journée à toi.

Sandra