Effectuer un "Text to columns" après le premier espace

Le 29/12/2015 à 13:45

Bonjour à tous,

Je me permets de revenir (déjà) vers vous car je me trouve de nouveau confrontée à un petit challenge VBA.

Vous trouverez-ci joint un petit extrait de mon fichier afin de vous aider à situer mon problème.

La colonne B de mon fichier contient actuellement du texte inutile, un numéro de client puis de nouveau du texte inutile.

Exemple "Prices 1H 2016 10062159 - CLIENT Beauty.xlsx"

Lorsque je travaillais manuellement, sans macro, j'avais pour habitude de faire un CTRL+H avec "Prices 1H 2016 " (notez l'espace après 2016) sur ma colonne B et en remplaçant pas rien du tout. Ceci afin de de me retrouver avec quelque chose de la forme :

10062159 - CLIENT Beauty.xlsx

Il me restait ensuite qu'à trier les codes clients par ordre croissant (car je peux être confrontée à deux types de codes clients : 6 ou 8 chiffres, puis à effectuer Data > text to colums pour isoler mon code client du reste de la cellule. Je supprimais ensuite le reste de ma cellule. (ici " - CLIENT Beauty.xlsx")

Mon problème VBA:

Je souhaite trouver une façon d'effectuer ce "Text to column" via VBA sachant que mes codes clients peuvent avoir deux tailles différentes.

Pour me donner une base de travail, étant débutante je suis passée par l'enregistreur macro.

Etape 1.

Range("B1").Select
    ActiveCell.FormulaR1C1 = "Prices 1H 2016 10062159 - CLIENT Beauty.xlsx"
    Columns("B2:B").Select
    Selection.Replace What:="Prices 1H 2016 ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Il me reste à trouver comment adapter ce morceau de code à un cas général, car évidemment mes clients portent d'autres noms que CLIENT.

Etape 2

Il s'agit ici d'effectuer mon text to column.

Afin qu'excel détermine tout seul la taille de mon code client je pensais lui faire exécuter le Text to Column à partir du premier espace constaté dans la cellule.

Par exemple, après mon étape 1 je devrais me retrouver avec une colonne B qui ressemble à ceci :

10062159 - CLIENT Beauty.xlsx

J'aimerai que mon text to colum commence juste après ou à partir de l'espace avant le tiret.

J'ai trouvé et bidouillé un petit bout de code, il ne fonctionne pas vraiment mais j'espère que c'est une piste!

Sub ExampleSplit1()
    Selection.TextToColumns _
      Destination:=Range("C2"), _
      DataType:=xlDelimited, _
      ConsecutiveDelimiter:=False, _
      Tab:=True, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
End Sub

Merci mille fois d'avance!

Belle journée!

24example.xlsx (9.35 Ko)
Le 29/12/2015 à 14:06

Bonjour,

Peux tu donner + d'exemples de la colonne B ou nous dire si c'est TOUJOURS la même présentation ?

Le début est toujours "Prices 1H " + année (je présume) et puis le code client ?

Autrement dit, le code client commence-t-il toujours à la même place ?

Cdlt

P.

Le 29/12/2015 à 14:17

@Patrick

Oui je confirme, ma colonne B sera toujours au format suivant:

Prices 1H 2016 10062159 - NomDeMonClient Beauty.xlsx

Il y aura donc toujours un espace entre 1H (le semestre) et l'année, puis entre l'année et le début du code client.

De la même manière, il y aura toujours un espace entre le code client et le tiret puis entre le tiret et le nom du client.

Je peux donc compter de manière certaine sur l'espace pour baser mon code, si tant est que ce soit faisable.

Le 29/12/2015 à 16:21

re,

essaye ceci sur ton exemple 

Option Explicit
Dim c As Range
Dim Tiret As Integer
Sub Milieu()
For Each c In Range("B2:B" & [B65000].End(xlUp).Row)
  On Error Resume Next
  Tiret = Application.Search("-", c)
  Cells(c.Row, 2) = Mid(c, 16, Tiret - 16)
Next
End Sub

Cdlt

Le 29/12/2015 à 16:24

Bonjour à tous,

La manipulation des chaines de caractères, c'est pas vraiment mon truc, donc prudence

Test sur la cellule B2, une imbrication de split.

Dim machaine As Variant
    machaine = Split(Split(Cells(2, 2).Value, "-")(0), " ")(3)

klin89

Le 29/12/2015 à 17:21

Merci à vous deux;

Juste un petit message pour vous dire que j'ai bien lu vos suggestions mais je ne serai pas en mesure de les essayer avant lundi (le fichier en question ne peut pas sortir du cadre professionnel!)

J'ignore quelle est la marche à suivre dans ce cas sur ce forum mais je reviens vers vous pour vous dire si cela a marché au plus vite!

Merci encore!

Le 04/01/2016 à 10:45
Klin89 a écrit :

Bonjour à tous,

La manipulation des chaines de caractères, c'est pas vraiment mon truc, donc prudence

Test sur la cellule B2, une imbrication de split.

Dim machaine As Variant
    machaine = Split(Split(Cells(2, 2).Value, "-")(0), " ")(3)

klin89

Bonjour Klin89,

Bonne année!

J'ai essayé votre code et malheureusement je me vois retourner sans cesse une erreur "Subscript out of range", que je ne comprends pas. Une idée ?

Le 04/01/2016 à 13:32

Bonjour

Un essai (juste de l'entrainement car ce n'est pas ma tasse de thé)

31quisemar-regexp-v001.xlsm (16.94 Ko)
Le 04/01/2016 à 15:15

Bonjour Banzai!

Merci pour votre proposition, en effet elle fonctionne bien dans le fichier d'exemple que je vous ai fourni.

J'ai donc ajouté la fonction dont vous m'avez fourni le code à mon module et essayé d'appliquer la même formule

=regexpfind(B2;"[0-9]{6,8}")

sur une colonne de mon véritable fichier, or je ne me vois pas retourner de résultat, juste un "#NAME?"

Je vous avoue que je suis complètement perdue quant au fonctionnement de la fonction que vous me proposez, aussi je l'ai appliquée bêtement...j'ai peut-être oublié quelque chose pour qu'elle puisse fonctionner sur mon fichier ?

Le 04/01/2016 à 15:31

Bonjour,

pourquoi ne pas envoyer un copie anonymisée de ton fichier, ça sera plus simple pour tous

P.

Le 04/01/2016 à 15:49

Bonjour

En principe #NAME? veut dire qu'il ne reconnait pas la fonction que tu utilises

Regarde du côté orthographe

Comme tu as XL Anglais vérifie les , (virgules) à la place des ; (points virgules)

et ensuite .... je ne sais pas

Le 04/01/2016 à 16:05
Quisemar a écrit :

Bonjour Banzai!

Merci pour votre proposition, en effet elle fonctionne bien dans le fichier d'exemple que je vous ai fourni.

J'ai donc ajouté la fonction dont vous m'avez fourni le code à mon module et essayé d'appliquer la même formule

=regexpfind(B2;"[0-9]{6,8}")

sur une colonne de mon véritable fichier, or je ne me vois pas retourner de résultat, juste un "#NAME?"

Je vous avoue que je suis complètement perdue quant au fonctionnement de la fonction que vous me proposez, aussi je l'ai appliquée bêtement...j'ai peut-être oublié quelque chose pour qu'elle puisse fonctionner sur mon fichier ?

Tu as bien coché comme indiqué dans le code ?

ça fonctionne chez moi en XL2007

de plus, tu as eu quelques autres réponses, tu as le choix

' Il faut cocher dans

' Menu Outils --> Références

' Microsoft VBScript Regular Expressions ...

Le 04/01/2016 à 17:12

Bonjour Patrick,

Je ne peux pas anonymiser tout mon fichier car il fait plus de 30000 lignes ce qui serait un peu fastidieux.

Mais vous avez tout à fait raison, il serait plus simple pour tout le monde de comprendre le contexte. Je n'ai pas osé dans un premier temps présenter mon projet macro global d'un coup car je ne voulais pas abuser du temps des forumers !

Mon fichier de base sur lequel je veux appliquer ma macro

En pièce-jointe vous trouverez un extrait du fichier global très brouillon qui m'est sorti d'une macro de consolidation de tous nos fichiers clients. Ces fichiers contiennent une feuille de données numériques (des prix vous l'aurez compris) et une feuille sous forme de lettre adressée au responsable commercial. La macro de consolidation a été fait de telle sorte qu'elle compile TOUT (y compris des fragments de la lettre) dans un seul fichier commun.

L'objectif de ma macro

Mon objectif est de faire une macro qui va récupérer ce fichier très brouillon et le traiter de façon à la formaliser sous la forme :

Colonne A: "LT01"

Colonne B: Le numéro de client (ce que je cherche à isoler via un text-to-column)

Colonne C : Le code d'identification du produit (IRC)

Colonne D : Le prix

Colonne E : La devise de facturation (que je compte récupérer sur un autre fichier via un vlookup sur mon numéro de client, ce sera la dernière étape de ma macro)

Colonne F : date de début (Qui est à rentrer par l'utilisateur en "Sheet1" Cellule A1 pour que la macro l'ajoute à toutes les lignes)

Colonne G : date de fin (Qui est à rentrer par l'utilisateur en "Sheet1" Cellule B1 pour que la macro l'ajoute à toutes les lignes également)

(Je vous joins également le fichier après passage par ma macro actuelle pour mieux visualiser où je veux en venir)

Ma macro à l'heure actuelle:

Ce sont mes premiers pas, à l'aveugle en VBA, je me base sur l'enregistreur pour les choses simples, puis j'adapte au cas général (mon fichier de travail ne fera pas toujours le même nombre de ligne). Pour les choses plus compliquées je m'aide du forum ou de bouts de code que je trouve sur d'autres topics.

De ma méconnaissance du code et des multiples sources sur lesquelles je m'appuie résulte probalement un code qui fera hurler les puristes, j'imagine bien qu'il est très brouillon et "sale".

C'est peut être pourquoi je n'arrive pas à intégrer le morceau de code que l'on me propose dans ce topic concernant mon text-to-column ?

Attention les yeux ca va piquer 

Sub LSMW_v1()
'
' LSMW_v1 Macro
'

'
    Columns("C:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    'Supprime la colonne vide C, la lettre en D, la lettre en E

    Columns("C:G").Select
    Range("C37").Activate
    Selection.Delete Shift:=xlToLeft
    'Supprime les restes de lettre

    Columns("D:D").Select
    Range("D37").Activate
    Selection.Delete Shift:=xlToLeft
    'Supprime la colonne EAN

    Columns("D:E").Select
    Range("D37").Activate
    Selection.Delete Shift:=xlToLeft
    'Supprime la colonne old IRC et la colonne vide voisine

    Columns("E:E").Select
    Range("E37").Activate
    Selection.Delete Shift:=xlToLeft
    'Supprime la colonne TR price

    Columns("E:P").Select
    Range("E37").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll Down:=-66
    'Supprime tout le reste inutile

    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp
    'Supprime la colonne A Introduction letter

    Columns("A:A").Insert Shift:=xlToLeft, _
      CopyOrigin:=xlFormatFromLeftOrAbove
      'Ajout d'une colonne à gauche de A

    Dim Lastrow As Long
    Lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1:A" & Lastrow).Formula = "LT01"
    'Remplissage SalesOrg jusqu'à la dernière ligne écrite. B= colonne de référence

    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    'Insert d'une ligne de titre en 1

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "SalesOrg"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Customer"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "IRC"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Price"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Currency"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "StarDate"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "EndDate"
    'Ecriture des titres

    Columns("A:G").Select
    ActiveWorkbook.Worksheets("ConsoSheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ConsoSheet").Sort.SortFields.Add Key:=Range( _
        "C2:C13823"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ConsoSheet").Sort
        .SetRange Range("A1:G13823")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Tri par IRC

    'SUPPRESSION DES LIGNES INUTILES

     Dim ws As Worksheet
     Dim lRows As Long
     Dim rng As Range
     Set ws = ActiveSheet

      lRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ' Initialisation plage de donnees à traiter
   Set rng = ws.Range("D2:D" & lRows)
    ' Avec la plage de donnees à traiter
   With rng
        ' Traitement des cellules vides
       .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        ' Traitement des constantes texte (valeurs non numériques)
       .SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
    End With
    ' RAZ variables objets

   Set rng = Nothing: Set ws = Nothing

     Dim Derco As Long
     Derco = Range("D" & Rows.Count).End(xlUp).Row

    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E2:E" & Derco).FormulaR1C1 = "=ROUND(RC[-1],2)"
    'Insertion d'une colonne E, arrondissement jusqu'à la dernière colonne

    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Price"
    Range("D2").Select
    'Copy-paste-value sur la colonne des prix précédemment arrondie

    Range("F2").FormulaR1C1 = "=Sheet1!R[-1]C[-5]"
    Range("G2").FormulaR1C1 = "=Sheet1!R[-1]C[-5]"
    Range("F2:G2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("F3:F" & Derco).Value = Cells(2, 6)
    Range("G3:G" & Derco).Value = Cells(2, 7)
    'Recuperation des dates en sheet1 cellule A et B et application sur la colonne entière

    'BLOC1 Vlookup sur les devises
    Application.ScreenUpdating = False
    'Nécessaire pour l'ouverture d'un fichier

    Dim wb As Workbook
    Set wb = Workbooks.Open("R:\TR_DP\PRICING\30 LSMW Macro\CurrenciesFile.xlsx")
    Set ws = wb.Worksheets(1)
    'Ouverture du fichier des devises

    wb.Close
    Application.ScreenUpdating = True

    End Sub

Voilà c'est long mais vous avez tout, si vous avez toujours le courage de m'aider!

21anonyme.xlsx (10.78 Ko)
26anonyme-apres-macro-actuelle.xlsx (8.62 Ko)
Le 04/01/2016 à 19:10

re,

pas le temps de tout réécrire, c'est pas top mais ça semble tourner et donner le résultat...

tu devrais pouvoir effacer toutes les colonnes qui te gênent en une seule fois avec un truc du genre (à tester):

Range("B:B, F:F, H:H").Select '

Selection.Delete Shift:=xlToLeft

si tu veux ne garder que le n° de client (ici 10062159), tu peux mettre mon code,mais pour l'appeler, il te faut juste avant ton end sub, écrire CALL Milieu qui va aller chercher le code en question.

Sub Milieu()
Dim c As Range
Dim Tiret As Integer
For Each c In Range("B2:B" & [B65000].End(xlUp).Row)
  On Error Resume Next
  Tiret = Application.Search("-", c)
  Cells(c.Row, 2) = Mid(c, 16, Tiret - 16)
Next
End Sub
Le 05/01/2016 à 10:46

Une fois cette macro terminée j'aurai un peu plus de temps pour apprendre le VBA de manière plus théorique, je reviendrai sur mon code pour le rendre plus propre quand j'aurai de bonnes bases!

En tous cas merci Patrick (et les autres), votre code marche très bien et j'ai appris à appeler une macro dans une macro!

Votre aide m'a été précieuse!

Rechercher des sujets similaires à "effectuer text columns premier espace"