Niveau 0 en VBA cherche à faire un macro

Le 04/03/2010 à 14:58

Bonjour à tous,

Le titre résume parfaitement ma position

On m'a sollicité pour faire qqchose qui n'est pas possible (enfin je pense....) à réaliser par formules.

Pour résumer, j'ai deux colonnes:

une avec des composants en A

une avec des produits finis en B

Le problème est que les personnes qui parfois créent des fichiers ne pensent pas toujours à ceux qui les exploitent

En effet pour un composant en A5, je peux avoir associer plusieurs PF associés en B5 séparés par un espace.

Je souhaite en fait avoir une ligne par couple Composant / Produits.

Je vous joint un fichier exemple avec les données de départ et le résultat souhaité pour être plus clair !!!

Merci à tous ceux qui pourront m'aider

Bonne journée

oSMoZ

51test-xl-forum.xls (14.00 Ko)
Le 06/03/2010 à 00:13

Bonjour oSMoZ, forum

Essaie avec ça :

Sub resultat_souhait()
Dim i As Long, dercol As Byte, test As Boolean

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    i = 2
    Do While Application.CountA(Range("B" & i & ":B65536")) > 0

        If Cells(i, 2) Like "*" & Chr(10) & "*" Then
            test = True
            Cells(i, 2) = Replace(Cells(i, 2), Chr(10), " ")
            Range("B" & i).TextToColumns Destination:=Range("B" & i), DataType:=xlDelimited, _
                                         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, TrailingMinusNumbers:=True
            dercol = Range("IV" & i).End(xlToLeft).Column
            Rows(i + 1 & ":" & i + dercol - 2).Insert Shift:=xlDown
            Range("B" & i + 1 & ":B" & i + dercol - 2) = Application.Transpose(Range(Cells(i, 3), Cells(i, dercol)))
            Range(Cells(i, 3), Cells(i, dercol)).ClearContents
            Range("A" & i).AutoFill Destination:=Range("A" & i & ":A" & i + dercol - 2), Type:=xlFillCopy
        End If
        i = IIf(test, i + dercol - 1, i + 1)

    Loop

    Cells.EntireRow.AutoFit

End Sub
9test-mango9-mfc-v2.xlsx (15.29 Ko)
Le 06/03/2010 à 10:32

Bonjour,

Comme j'ai planché dessus hier soir, voici une alternative à celle de VBA New

Sub test()
'Macro Dan pour Ozmoz le 06/03/2010 -  XL Pratique
'http://forum.excel-pratique.com/excel/niveau-0-en-vba-cherche-a-faire-un-macro-t15915.html
Dim dlg As Integer
Dim i As Byte, j As Byte
Dim c As Range
For Each c In Range("B2:B" & Range("B65536").End(xlUp).Row)
c = Trim(c)
c.Replace What:=Chr(13), Replacement:=""
Next c
dlg = Range("A65536").End(xlUp).Row + 1
i = 11
For Each c In Range("B2:B" & Range("B65536").End(xlUp).Row)
If Range("B" & c.Row) = "" Then Range("A" & dlg) = Range("A" & c.Row): dlg = dlg + 1
For j = 1 To Len(c) / i
Range("A" & dlg) = Range("A" & c.Row)
Range("B" & dlg) = Mid(Range("B" & c.Row), (j * i) - 10, i)
dlg = dlg + 1
Next
Next
End Sub

Le code recopiera tes données en dessous de la liste. Veille donc à n'avoir que des cellules vides en dessous de ta liste de données en colonne A et B.

Amicalement

Dan

Le 06/03/2010 à 11:10

Bonjour forum, dan,

Juste une petite correction, il faut changer la ligne :

c.Replace What:=Chr(13), Replacement:=""

par

c.Replace What:=Chr(10), Replacement:=""

car dans les cellules, on a des sauts de ligne (chr(10)) plutôt que des sauts de paragraphe (chr(13)).

Le 06/03/2010 à 12:09

Re,

Surtout pas VBANEW, si tu fais cela le code devient complètement erroné et ne renvoit pas ce qui est recherché.

Il faut laisser Chr(13) qui enlève le retour à la ligne dans une cellule.

Amicalement

Dan

Le 06/03/2010 à 15:36

Re dan,

Voici ce que ça fait chez moi avec ton code :

capturer

Un problème chez moi peut-être ? As-tu retesté de ton côté ?

Le 06/03/2010 à 15:57

Re,

VBAnew avec Chr(10) chez moi, cela donne exactement ce que tu me montres.

A moins qu'il y aurait un souci entre Chr(13) et Chr(10) entre les version d'excel ??

Dan

Le 06/03/2010 à 16:21

Bizarre tout ça

Pour ma part, je viens de refaire le test avec ton code sur excel 2003 et ça ne marche pas

Le 06/03/2010 à 19:06

Re,

Ok VBANew, je viens de faire un test sur excel 2003 et je trouve le même souci que toi. Il semble donc qu'il s'agit bien d'un souci lié aux versions excel, et ce d'autant que j'ai monté le code sous MAC excel 2004.

Pour contourner cela, il faut remplacer Chr(13) ou Chr(10) par VBLF. Le code fonctionne alors sur chaque version.

Pour Osmoz, dans mon code remplacer cette ligne :

c.Replace What:=chr(13), Replacement:=""

par celle-ci

c.Replace What:=vbLf, Replacement:=""

Amicalement

Dan

Le 06/03/2010 à 23:01

Bonsoir à tous,

Dan, je note l'info pour le "vbLf"

Autre alternative avec Split

Sub Separe()
Dim A%, J%, i As Byte, Sp, x, y
''Macros par Claude Dubois pour "oSMoSp" E-P le 6/03/2010
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
        Range("c:d").Columns.Insert
        Range("a1:b1").Copy Destination:=Range("c1")
    For A = 2 To Range("a65536").End(xlUp).Row
            J = Range("c65536").End(xlUp)(2).Row
            x = WorksheetFunction.Ceiling(Len(Cells(A, 2)) / 12, 1)
        If x > 1 Then
            Cells(A, 2) = WorksheetFunction.Substitute(Cells(A, 2), vbLf, " ")
            Sp = Split(Cells(A, 2))
            y = 0
                For i = 1 To x
                    Cells(J, 3) = Cells(A, 1)
                    Cells(J, 4) = Sp(y)
                    J = J + 1
                    y = y + 1
                Next i
            Else
                Cells(J, 3) = Cells(A, 1)
                Cells(J, 4) = Cells(A, 2)
        End If
    Next A
        Range("a:b").Columns.Delete
End Sub

Amicalement

Claude

30osmoz.zip (12.84 Ko)
Le 08/03/2010 à 08:34

re,

Ou làlà, Osmoz semble avoir le choix là...

Attention Claude que la fonction SPLIT ne fonctionne pas sur toutes les versions excel et en tout cas pas sur Excel MAC.

Les variables X et Y peuvent aussi être déclarées Byte plutôt que Variant il me semble.

Attendonc notre ami Osmoz.

Dan

Le 08/03/2010 à 09:00

Bonjour Dan, forum,

Les variables X et Y peuvent aussi être déclarées Byte plutôt que Variant il me semble.

Ok d'accord, peux-tu me rappeler les inconvénients de laisser une variable en Variant ?

  • consomme plus de mémoire ?
  • ralenti l'exécution ?
ou simple question de syntaxe générale

Bonne journée

Claude

Le 08/03/2010 à 09:57

Bonjour à tous

Tout d'abord merci d'avoir pris de votre temps pour résoudre mon problème

En testant les différents codes et en modifiant une partie de mes données (il restait des / et des + qui trainaient ds la colonne B) :

Le code de Claude fonctionne bien, il me sépare bien les données. Cependant il bloque à cet endroit :

   Cells(J, 4) = Sp(y)

mais ce n'est pas un soucis car j'ai la donnée que je souhaitais avoir dans les colonnes C & D .

Concernant le code de Dan, il ne fonctionne pas correctement (j'ai bien remplacé la ligne comme signalé dans le message), il me revoie ces données pour la ligne A5 :

65NOT1000/A 1ATRO1000BE

65NOT1000/A 1ATRO1016B

65NOT1000/A E 1ATRO1017

Mais pas de soucis, ne perdez pas de temps sur mon post, le plus important est là, car j'ai le résultat demandé

Encore un grand merci à tous, je ne sais pas ce que je ferais sans vous

Bonne journée

oSMoZ

Le 08/03/2010 à 10:14

Re,

Non Osmoz le code renvoie correctement ce que tu demandes.

Comme il y a eu pas de posts à ce sujet voici le code :

Sub test()
'Macro Dan pour Ozmoz le 06/03/2010 -  XL Pratique
'http://forum.excel-pratique.com/excel/niveau-0-en-vba-cherche-a-faire-un-macro-t15915.html
Dim dlg As Integer
Dim i As Byte, j As Byte
Dim c As Range
For Each c In Range("B2:B" & Range("B65536").End(xlUp).Row)
c = Trim(c)
c.Replace What:=vbLf, Replacement:=""
Next c
dlg = Range("A65536").End(xlUp).Row + 1
i = 11
For Each c In Range("B2:B" & Range("B65536").End(xlUp).Row)
If Range("B" & c.Row) = "" Then Range("A" & dlg) = Range("A" & c.Row): dlg = dlg + 1
For j = 1 To Len(c) / i
Range("A" & dlg) = Range("A" & c.Row)
Range("B" & dlg) = Mid(Range("B" & c.Row), (j * i) - 10, i)
dlg = dlg + 1
Next
Next
End Sub

Vois le fichier joint avec ce que cela donne après traitement.

Pour Claude : Pas de rapidité en quelque sorte mais plutôt Gestion de mémoire.

Dan

osmoz
Le 08/03/2010 à 10:15

Bonjour,

Pour info, le bug dans mon code provient de la variable x

For i = 1 To x

il aurait fallut que je comptabilise le nombre de retour ligne, ce que je n'ai pas su faire correctement !

si bien que le code doit boucler 1 tour de trop.

Bonne journée

Claude

édit: merci Dan

Rechercher des sujets similaires à "niveau vba cherche macro"