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...