VBA - Garder 6 premiers carratères

[Fredox]

Bonjour,

Une nouvelle fois besoin d'aide:

Je souhaiterai sur ma plage "Range("B8:B1008)" garder uniquement les 6 premiers carractères (il n'y a pas d'espace), chaine alphanumérique
Ensuite de voudrais ajouter une espace entre le 3ème et le 4ème caractère.

C'est possible ?

Merci

 

[Lolote83]

Salut,
Pas besoin de VBA, une simple formule devrait donner les résultat escompté
en C8 = GAUCHE(B8;2) & " " & STXT(B8;3;1) & " " & STXT(B8;4;2) puis tirer vers le bas
Si toutefois, j'ai bien compris la consigne
@+ Lolote83

 

[Fredox]

Bonjour Lolote83,
Impératif en VBA, c'est un document complexe avec une mise en page par VBA a partir d'un document vierge dans lequel je colle des données stockées dans le presse papier

 

[Lolote83]

Re bonjour,
Puisque VBA oblige, alors voilà du VBA
Attention, la macro écrira les résultats en colonne C (Offset0,1). Si autre colonne à prevoir, modifier la valeur 1 en 2 pour D, 3 pour E .....

Sub SixCaracteres()
    Application.ScreenUpdating = False
    For Each xCell In Range("B8:B1008")
       xCell.Offset(0, 1) = Left(xCell, 2) & " " & Mid(xCell, 3, 1) & " " & Mid(xCell, 4, 2)
    Next xCell
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

 

[job75]

Bonjour Fredox, Lolote83,

Avec un tableau VBA c'est toujours plus rapide :

Sub a()
Dim tablo, i&, x$
With [B8:B1008]
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        x = Replace(tablo(i, 1), " ", "")
        tablo(i, 1) = Trim(Left(x, 3) & " " & Mid(x, 4, 3))
    Next
    .Value = tablo
End With
End Sub

PS : @Lolote83 attention votre formule ne correspond pas à la demande.

A+

 

[Lolote83]

Salut Job75,
Bien vu le coup du tableau VBA. J'ai encore du mal a l'utiliser.
Bien vu aussi pour la consigne, je me suis un peut mélangé les pinceaux. un espace de trop.
Finalement, il vaut mieux 2 yeux aguerris plutôt qu'un seul.
@+ Lolote83

 

[Fredox]

Ca parrait peut-être bête pour vous, mais pour moi…. incroyable!

Merci beaucoup de votre aide Job75 et Lolote83

 

[jmfmarques]

Bonjour
Hé bien je vais vous proposer une solution plus amusante :
Exemple ici avec données en colonne A

  Dim plage As Range, c As Range
  Application.DisplayAlerts = False 'pour éviter une confirmation d'écrasement
  Set plage = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
  plage.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
  For Each c In plage.Cells
    If Len(c.Value) = 6 Then
      c.Value = Format(c.Value, "@@@ @@@")
    End If
 Next
  Application.DisplayAlerts = True

 

[Webperegrino]

Bonjour Fredox, Lolote83, Job75, jmfmarques,

Job75, je cherche à comprendre le fonctionnement de la fonction très intéressant "tablo".

Comment modifier vos lignes en #5 pour que le résultat se place par exemple non plus en colonne B de Feuil1 mais en colonne C de Feuil2 ?
Ici on restera sur la même feuille.
Mais j'ai pour objectif, dans une autre application, de :
- conserver le contenu de la colonne B de Feuil1 (utilisée en éléments de Paramètres)
- placer le résultat en colonne C de Feuil2 grâce à votre macro VBA.

Avec ...

...
  Next
  '.Value = tablo
End With
[I]For i = 8 To 1008
  Cells(i, 3).Value = tablo 'ou encore tablo(i, 1)
Next i[/I]
End Sub

cela n'est pas accepté.
Merci pour votre précieuse aide.
Webperegrino

 

[jmfmarques]

Je vois que ma solution amusante n'emballe pas les foules.
Vous la trouvez sans doute trop longue ? -->> Alors voilà du plus court (mais moins amusant) :

 For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
    If Len(c.Value) > 5 Then c.Value = Format(Left(c.Value, 6), "@@@ @@@")
  Next

 

[job75]

Bonjour Webperegrino,

tablo n'est pas une fonction, c'est un Array (matrice).

Si l'on part de Feuil1 pour aller sur Feuil2 (CodeNames) :

Sub b()
Dim tablo, i&, x$
tablo = Feuil1.[B8:B1008] 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = Replace(tablo(i, 1), " ", "")
    tablo(i, 1) = Trim(Left(x, 3) & " " & Mid(x, 4, 3))
Next
Feuil2.[C8:C1008] = tablo
End Sub

A+

 

[Webperegrino]

Bonsoir Job75,
Merci pour cette dernière précision.
Vos lignes exécutent le travail plus rapidement.
Cela va beaucoup me servir.
Je prendrai soin de cette trouvaille Array-Matrice et la range dans mon petit lexique "Macros Excel" enrichi grâce à ce Forum, pour d'autres utilisations.
Webperegrino

 

[Staple1600]

Bonsoir le fil

Je vois que ma solution amusante n'emballe pas les foules.
Vous la trouvez sans doute trop longue ? -->> Alors voilà du plus court (mais moins amusant) :

Personnellement, si utilisation de Données/Convertir : pas besoin de VBA
Mais si il faut faire jouer dans VBE, alors voila comment je joue 😉

Sub Test()
Six Range("C1")
End Sub
Private Sub Six(R As Range)
Dim SixOnly
SixOnly = Array(Array(0, 1), Array(6, 9))
Columns(R.Column).TextToColumns Destination:=R.Cells(1), DataType:=xlFixedWidth, FieldInfo:=SixOnly
End Sub

NB: Ici dans l'exemple, les données sont en colonne C.

 

[job75]

[Gentiment]
A méditer : répondre à des messages qui ne servent à rien ça ne sert à rien.
[\Gentiment]

 

[Staple1600]

Bonsoir job75

[Gentiment]
A méditer itou:
Ajouter N messages sous prétexte d'amélioration dans une discussion alors que le mode Edition existe, ça ne sert à rien 🙄
(à part incrémenter le compteur de post du répondeur)
[/Gentiment]
+1 pour job75
+1 pour Staple

Qui un jour a parlé du bel esprit XLDien où les membres échangent dans la joie et la bonne humeur...