Aide macros conversion données

Le 25/05/2011 à 09:39

Bonjours tout le monde,

Je viens vous voir car j’ai besoin de votre aide pour réaliser deux macro de mise en forme de données. Je les ait réalisés avec l’enregistreur de macro, et je viens vous voir pour vous demander vos avis sur celles-ci (comment les améliorer …)

La première consiste à transformer ce qu’il y a dans la colonne I

<?xml version="1.0" encoding="ISO-8859-1"?><br/><xml_data><br/><var name="inv_civil">M.</var><br/><var name="dlv_civil">M.</var><br/><var name="inv_address1">3 rue alphonse de lamartine</var><br/><var name="dlv_address1">3 rue alphonse de lamartine</var><br/><var name="inv_lastname">DUPONT</var><br/><var name="dlv_lastname">DUPONT</var><br/><var name="inv_firstname">Jean</var><br/><var name="dlv_firstname">Jean</var><br/><var name="inv_town">Paris</var><br/><var name="dlv_town">Paris</var><br/><var name="inv_email">jean.dupont@neuf.fr</var><br/><var name="dlv_email">jean.dupont@neuf.fr</var><br/><var name="inv_codepost">101213</var><br/><var name="dlv_codepost">101213</var><br/><var name="inv_country">France </var><br/><var name="dlv_country">France </var><br/><var name="inv_tel">0678910111</var><br/><var name="dlv_tel">0678910111</var><br/></xml_data><br/>

En DUPONT Jean

Voilà la première macro que j’ai réalisée :

Sub Macro1()
   Columns("I:I").Select
    Selection.Cut
    Range("W1").Select
    ActiveSheet.Paste
    Selection.TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=">"
        Columns("W:AP").Select
    Range("AP1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("Y:Y").Select
    Selection.Delete Shift:=xlToLeft
    Range("Z:AN,AO:DZ").Select
    Range("AO1").Activate
    Selection.ClearContents
Columns("W:W").Select
    Selection.TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="<"
    Columns("Y:Y").Select
    Selection.TextToColumns Destination:=Range("Y1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="<"
Range("AA2").Select
    ActiveCell.FormulaR1C1 = "=RC[-4]&"" ""&RC[-2]"
    Range("AA2").Select
    Selection.AutoFill Destination:=Range("AA2:AA65536"), Type:=xlFillDefault
Columns("AA:AA").Select
    Selection.Copy
    Range("I1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Columns("W:AA").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select

End Sub

Mon problème vient surtout de la lenteur de la macro (parce que le fichier fait 3000+ lignes, mais bon encore ca passe), et de la sélection des champs (car j'ai tout sélectionné à la main alors des lignes se rajouteront au fur et à mesure !)

(et elle marche pas pour tout, car des fois il y a des "adresses2"... mais c'est pas vraiment grave, y en a pas beaucoup donc je peux le faire à la main).

La seconde macro (je la trouve moins réussie) cherche à transformer le code suivant:

<?xml version="1.0" encoding="ISO-8859-1"?><br/><xml_data><br/><var name="prod0">01837|COR27#stylo |59.00|0.000|1</var><br/></xml_data><br/>

En : une colonne avec la référence (COR27) suivi de la colonne avec le prix (59). Il peut y avoir des comandes avec 1seul produit, ou des commandes avec 15 produits !

Sub Macro2()
'
Columns("H:H").Select
    Selection.Cut Destination:=Columns("W:W")
    Columns("W:W").Select
    Selection.TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|"
Columns("Y:Y").Select
    Selection.Insert Shift:=xlToRight
    Columns("AD:AD").Select
    Selection.Insert Shift:=xlToRight
Columns("AH:AH").Select
    Columns("AI:AI").Select
    Selection.Insert Shift:=xlToRight
    Columns("X:X").Select
    Selection.TextToColumns Destination:=Range("X1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="#"
    Columns("AC:AC").Select
    Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="#"

    Columns("AH:AH").Select
    Selection.TextToColumns Destination:=Range("AH1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="#"
    Range("W:W,Y:Y,AA:AB,AD:AD,AF:AG,AI:AI,AK:AL").Select
    Range("AK1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("V:AC").Select
    Selection.Cut
Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
End Sub

Ici le problème vient surtout pour la sélection du bon nombre de colonne (pour la suppression des colonnes au début, ou pour faire le couper/coller à la fin), car dans certaines commandes, il y aura 1 produit ou dans d’autres 50 : donc je ne sais pas comment lui dire de, par exemple, supprimer la première colonne, puis une colonne sur 2. Pareil pour le copier coller dans le tableau, comment lui dire de sélectionner toutes les colonnes où il y a une cellule non-vide … ?

Voilà, j’espère que quelqu’un aura le courage de se pencher sur mon problème (*croise les doigts*).

Je vous joins un fichier-exemple avec la configuration de mon fichier-fichier.

(Si vous ne comprenez pas ce que je veux dire n’hésitez pas à poser la question)

Merci d’avance et à bientôt

24001.zip (4.60 Ko)
Le 25/05/2011 à 11:20

Bonjour,

Ci-dessous un code à essayer en lieu et place de ton premier souci :

Sub Macro1()
'Macro wana07 - Modif Dan - 25/05/11
Dim dlg As Long
dlg = Range("I" & Rows.Count).End(xlUp).Row
Range("I1:I" & dlg).Cut Range("W1")
Range("W1:W" & dlg).TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=">"
Columns("W:AP").Delete Shift:=xlToLeft
Columns("Y:Y").Delete Shift:=xlToLeft
Columns("Z:DZ").Delete
Application.DisplayAlerts = False
Range("W1:W" & dlg).TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="<"
Range("Y1:Y" & dlg).TextToColumns Destination:=Range("Y1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="<"
With Range("AA2")
    .FormulaR1C1 = "=RC[-4]&"" ""&RC[-2]"
     .AutoFill Destination:=Range("AA2:AA" & dlg), Type:=xlFillDefault
End With
Range("AA2:AA" & dlg).Copy
Range("I2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Columns("W:AA").Delete
Range("A1").Select
End Sub

Si ok, je ferai le deuxième sur base de celui là.

Amicalement

Le 25/05/2011 à 16:40

Salut Dan, merci pour ton aide.

J'ai essayé le code que tu m'as donné; et il marche trés bien!

Mais à ton avis, est ce que ce serait mieux de combiner ces deux macros en 1 ou il ne vaut mieux pas (pour éviter des bug?)

Le 26/05/2011 à 13:07

Re,

Voici le deuxième code :

Sub Macro2()
'Macro wana07 - Modif Dan - 26/05/11
Dim dlg As Long
Application.ScreenUpdating = False
dlg = Range("I" & Rows.Count).End(xlUp).Row
Columns("H:H").Cut Destination:=Columns("W:W")
Range("W1:W" & dlg).TextToColumns Destination:=Range("W1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"
Columns("Y:Y").Insert Shift:=xlToRight
Columns("AD:AD").Insert Shift:=xlToRight
Columns("AI:AI").Insert Shift:=xlToRight
Range("X1:X" & dlg).TextToColumns Destination:=Range("X1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="#"
Range("AC1:AC" & dlg).TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="#"
Range("AH1:AH" & dlg).TextToColumns Destination:=Range("AH1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="#"
Range("W:W,Y:Y,AA:AB,AD:AD,AF:AG,AI:AI,AK:AL").Delete Shift:=xlToLeft
Range("W2:AC" & dlg).Cut
Range("H2").Insert Shift:=xlToRight
Range("A1").Select
End Sub

Afin que les deux codes s'enchainent l'un à la suite de l'autre mets cette instruction à la fin du code 1 et ce, juste avant le END SUB. Cela donnerait ceci

Sub macro1()
'.....le code de la macro 1
Call Macro2
End Sub

Une autre chose que tu peux ajouter au début de la macro 1 (juste en desous de Dim....) --> Application.ScreenUpdating = False

Si ok, n'oublie pas de cliquer sur le V vert juste à coté du bouton Editer pour cloturer le fil.

Amicalement

Le 27/05/2011 à 17:39

Un grand merci à toi, ces macros fonctionnent super bien

Rechercher des sujets similaires à "aide macros conversion donnees"