[Exercice] Le meilleur algo (sous Excel) [Résolu]

[argyronet]

Bonjour,

Voici un petit exercice intéressant, enfin j'espère.
Par ce jeu d'enregistrements inscrit tel que dans les colonnes A, B,C,D, E et F:

Code :

1
2
3
4
ID        Valeur   Texte                  Montant	Coef	 Total
A1,A2,A3  VA	   TA1,TA2,TA3,TA4,TA5	  101,00   	2,50%	 103,53   
B1	  VB1,VB2  TB1,TB2	          173,00       41,00%	 243,93   
C1,C2	  VC	   TC1	                  125,00       28,00%	 160,00

J'attends de vous le meilleurs algo pour obtenir le tableau suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
ID	Valeur	Texte	 Montant         Coef    Total
A1	VA	TA1	 101,00   	2,50%	 103,53   
A1	VA	TA2	 101,00   	2,50%	 103,53   
A1	VA	TA3	 101,00   	2,50%	 103,53   
A1	VA	TA4	 101,00   	2,50%	 103,53   
A1	VA	TA5	 101,00   	2,50%	 103,53   
A2	VA	TA1	 101,00   	2,50%	 103,53   
A2	VA	TA2	 101,00   	2,50%	 103,53   
A2	VA	TA3	 101,00   	2,50%	 103,53   
A2	VA	TA4	 101,00   	2,50%	 103,53   
A2	VA	TA5	 101,00   	2,50%	 103,53   
A3	VA	TA1	 101,00   	2,50%	 103,53   
A3	VA	TA2	 101,00   	2,50%	 103,53   
A3	VA	TA3	 101,00   	2,50%	 103,53   
A3	VA	TA4	 101,00   	2,50%	 103,53   
A3	VA	TA5	 101,00   	2,50%	 103,53   
B1	VB1	TB1	 173,00   	41,00%	 243,93   
B1	VB1	TB2	 173,00   	41,00%	 243,93   
B1	VB2	TB1	 173,00   	41,00%	 243,93   
B1	VB2	TB2	 173,00   	41,00%	 243,93   
C1	VC	TC1	 125,00   	28,00%	 160,00   
C2	VC	TC1	 125,00   	28,00%	 160,00

On considère que les colonnes ID, Valeur et Texte peuvent contenir un nombre aléatoire de valeurs séparées par des virgules...
Les 3 autres ne changent pas pour une même ligne.

A vos claviers...

Argy

[jpcheck]

Salut,
voici ma proposition, dans laquelle on voit bien la decomposition, ou je recopier sur la feuille 1 dans les colonnes H a M :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub pioupiou()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim varID As Variant
Dim varValeur As Variant
Dim varText As Variant
For i = 2 To Worksheets(1).Range("A65536").End(xlUp).Row
    varID = Split(Worksheets(1).Range("A" & i).Value, ",")
    varValeur = Split(Worksheets(1).Range("B" & i).Value, ",")
    varText = Split(Worksheets(1).Range("C" & i).Value, ",")
    For j = 0 To UBound(varID)
        For k = 0 To UBound(varValeur)
            For l = 0 To UBound(varText)
                Worksheets(1).Range("H" & Worksheets(1).Range("H65536").End(xlUp).Row + 1).Value = varID(j)
                Worksheets(1).Range("I" & Worksheets(1).Range("I65536").End(xlUp).Row + 1).Value = varValeur(k)
                Worksheets(1).Range("J" & Worksheets(1).Range("J65536").End(xlUp).Row + 1).Value = varText(l)
                Worksheets(1).Range("K" & Worksheets(1).Range("K65536").End(xlUp).Row + 1).Value = Worksheets(1).Range("D" & i).Value
                Worksheets(1).Range("L" & Worksheets(1).Range("L65536").End(xlUp).Row + 1).Value = Worksheets(1).Range("E" & i).Value
                Worksheets(1).Range("M" & Worksheets(1).Range("M65536").End(xlUp).Row + 1).Value = Worksheets(1).Range("F" & i).Value
            Next l
        Next k
    Next j
Next i
End Sub

[argyronet]

Hey... JP !

Je n'aborde pas l'entrée dans la plage de cette manière car le .End() s'écrase
souvent devant un .SpecialCells().
En dehors de cela, j'ai le même jeu de boucles avec un objet Range pour le remplissage final...
Je ne sais pas si on peut faire mieux.

Au suivant...

[Heureux-oli]

Salut,

Pourquoi tant de haine et limiter à Excel !

Pour Word :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Sub SplitTables()
Dim intLi As Integer
Dim stId() As String
Dim stValeur() As String
Dim stTexte() As String
Dim intA1 As Integer
Dim intA2 As Integer
Dim intA3 As Integer
Dim oTbl1 As Table
Dim oTbl2 As Table
 
Set oTbl1 = ActiveDocument.Tables(1)
 
Set oTbl2 = ActiveDocument.Tables.Add(Range:=ActiveDocument.Paragraphs.Last.Range, numrows:=1, numcolumns:=6)
 
 
For intLi = 2 To oTbl1.Rows.Count
'Split des valeurs du tableau
stId = Split(NetText(oTbl1.Cell(intLi, 1).Range.Text), ",")
stValeur = Split(NetText(oTbl1.Cell(intLi, 2).Range.Text), ",")
stTexte = Split(NetText(oTbl1.Cell(intLi, 3).Range.Text), ",")
'Boucles de remplissage
    For intA1 = 0 To UBound(stId)
        For intA2 = 0 To UBound(stValeur)
            For intA3 = 0 To UBound(stTexte)
                oTbl2.Rows.Last.Cells(1).Range.Text = stId(intA1)
                oTbl2.Rows.Last.Cells(2).Range.Text = stValeur(intA2)
                oTbl2.Rows.Last.Cells(3).Range.Text = stTexte(intA3)
                oTbl2.Rows.Last.Cells(4).Range.Text = NetText(oTbl1.Cell(intLi, 4).Range.Text)
 
                oTbl2.Rows.Last.Cells(5).Range.Text = NetText(oTbl1.Cell(intLi, 5).Range.Text)
                oTbl2.Rows.Last.Cells(6).Range.Text = NetText(oTbl1.Cell(intLi, 6).Range.Text)
                oTbl2.Rows.Add
            Next intA3
        Next intA2
    Next intA1
Next intLi
Set oTbl1 = Nothing
Set oTbl2 = Nothing
 
End Sub
 
'Fonction de nettoyage
Function NetText(stTemp As String) As String
NetText = Left(stTemp, Len(stTemp) - 2)
 
End Function

J'ai pas crée par code la seconde table, je l'ai ajoutée avant de lancer le code.

[argyronet]

Pas mal non plus...

Pourquoi tant de haine et limiter à Excel !

Disons que le besoin était effectivement sous Excel... et donc l'objet du défi par voie de conséquence;

En le lançant, j'espérais qu'un DVP Quidam aurait usé d'un algo autre que le miens qui s'image de près à celui de JPCheck...

Merci en tout cas, c'est super

Argy

[Heureux-oli]

Salut Argy,

Word n'étant pas équipé d'outils comme Excel, il faut tout faire.
Initialement, je pensais que ce serait un traitement long, mais ce n'est pas le cas.
J'ai cru qu'il ne fonctionnait pas, j'ai pas eu de message d'erreur et le sablier ne s'est pas affiché.

[mayekeul]

bonjour,

mon code n'apporte rien de bien neuf, mais je le trouve plus efficace comme ça

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub distribute()
Dim InitRng As Range
Dim vID As Variant, vvID As Variant
Dim vValeur As Variant, vvValeur As Variant
Dim vTexte As Variant, vvTexte As Variant
Dim vMontant, vCoef, vTotal, RC, R
 
Set InitRng = Range("A1").CurrentRegion
R = 1
 
For RC = 1 To InitRng.Rows.Count
    vID = Split(InitRng.Cells(RC, 1), ",")
    vValeur = Split(InitRng.Cells(RC, 2), ",")
    vTexte = Split(InitRng.Cells(RC, 3), ",")
    vMontant = InitRng.Cells(RC, 4)
    vCoef = InitRng.Cells(RC, 5)
    vTotal = InitRng.Cells(RC, 6)
    For Each vvID In vID
        For Each vvValeur In vValeur
            For Each vvTexte In vTexte
                Sheets(2).Cells(R, 1) = vvID
                Sheets(2).Cells(R, 2) = vvValeur
                Sheets(2).Cells(R, 3) = vvTexte
                Sheets(2).Cells(R, 4) = vMontant
                Sheets(2).Cells(R, 5) = vCoef
                Sheets(2).Cells(R, 6) = vTotal
                R = R + 1
            Next vvTexte
        Next vvValeur
    Next vvID
Next RC
 
End Sub

voila, à vot' bon coeur msieur dame...

[argyronet]

Merci mayekeul...
L'efficacité ("je le trouve plus efficace comme ça") reste à mesurer...

Je constate qu'il n'y a pas 36 solutions et que celle que j'ai mis moi-même en place... ressemble pour sa quasi totalité à la solution proposée par jpcheck que je remercie aussi.

Merci également à Heureux-oli qui a donné une version pour Word fort intéressante.

Je considère que ce défi est clos...

Argy

[kadden]

J'ai juste une petite proposition,
on a un point en commun, c'est de connaître l'algorithme,

mais rare sont les gens qui risque de comprendre ligne par ligne le code en haut,

je propose à la personne qui poste un code, de le commenter ligne par ligne, ou bien de noter un paragraphe pour expliquer le code noté

Merci

[X-L-P]

Bonjour,

C'est bien dommage qu'il n'y ait plus eu de défis Excel depuis 2010

Je constate qu'il n'y a pas 36 solutions et que celle que j'ai mis moi-même en place... ressemble pour sa quasi totalité à la solution proposée par jpcheck que je remercie aussi.

Effectivement, en temps normal j'aurais créé une solution similaire à celle de JP ...

Je me suis donc lancé le défi de créer une macro différente et la plus courte possible (en espérant relancer un peu cette partie "Défis" qui semble à l'abandon)

Le résultat :

2 boucles (au lieu de 4) + 4 lignes (pour les 6 colonnes) et c'est tout (par contre, dans sa version réduite, le code pique un peu les yeux ) :

Code :

1
2
3
4
5
6
7
8
9
10
Sub defi_xlp()
    For ligne = 2 To 4
        For i = 0 To (UBound(Split(Cells(ligne, 1), ",")) + 1) * (UBound(Split(Cells(ligne, 2), ",")) + 1) * (UBound(Split(Cells(ligne, 3), ",")) + 1) - 1
            Range("G" & Range("G1000").End(xlUp).Row + 1) = Split(Cells(ligne, 1), ",")(Int(i / ((UBound(Split(Cells(ligne, 1), ",")) + 1) * (UBound(Split(Cells(ligne, 2), ",")) + 1) * (UBound(Split(Cells(ligne, 3), ",")) + 1) / (UBound(Split(Cells(ligne, 1), ",")) + 1))))
            Range("H" & Range("H1000").End(xlUp).Row + 1) = Split(Cells(ligne, 2), ",")(Int(i / ((UBound(Split(Cells(ligne, 1), ",")) + 1) * (UBound(Split(Cells(ligne, 2), ",")) + 1) * (UBound(Split(Cells(ligne, 3), ",")) + 1) / (UBound(Split(Cells(ligne, 2), ",")) + 1))))
            Range("I" & Range("I1000").End(xlUp).Row + 1) = Split(Cells(ligne, 3), ",")(i Mod (UBound(Split(Cells(ligne, 3), ",")) + 1))
            Range("D" & ligne & ":F" & ligne).Copy Range("J" & Range("J1000").End(xlUp).Row + 1 & ":L" & Range("J1000").End(xlUp).Row + 1)
        Next
    Next
End Sub

Si ça intéresse quelqu'un, je peux poster la version telle qu'elle était avant qu'elle soit réduite en un minimum de lignes ...