[Exercice] Défi VBA n°1 (cubes)

Quelques exercices pour mettre en pratique vos connaissances VBA ... Prêt à relever le défi ?
Avatar du membre
Sébastien
Administrateur
Administrateur
Messages : 1'954
Appréciations reçues : 154
Inscrit le : 4 décembre 2004
Version d'Excel : 2013
Téléchargements : Mes applications
Contact :

Message par Sébastien » 28 avril 2013, 03:12


Défi VBA n°1 (cubes)
Que ce soit pour le plaisir de relever ce défi ou simplement pour vous entraîner, je vous propose un petit exercice pas trop long à réaliser et plutôt sympathique :wink:

Pour rendre l'exercice plus intéressant, les résultats des autres participants ne seront pas publiés tout de suite pour éviter que vous ne soyez tenté de vous en inspirer (malgré vous) et vous forcer à rechercher des solutions par vous-même.

Et quelques jours plus tard, à la publication, on devrait avoir à disposition des résultats assez variés et vous y découvrirez probablement des solutions auxquelles vous n'aviez pas pensé.

Je pense que ça peut être très intéressant comme exercice, ce "défi n°1" est un test (si c'est quelque chose qui vous plaît, il y en aura peut-être d'autres).

L'exercice
Une cellule contient des données représentant un ou plusieurs blocs aux dimensions variables (les blocs sont séparés par des / ).

Par exemple, si la cellule contient 6x6x3/3x3x3, cela correspond à 2 blocs :
  • Dimensions du bloc 1 : 6x6x3
  • Dimensions du bloc 2 : 3x3x3
LE PROBLEME :

Imaginez que vous deviez découper tous ces blocs en cubes de taille identique, en faire les plus gros cubes possible et sans aucun reste, combien de cubes obtenez-vous ?


PAR EXEMPLE :

Avec un bloc de 6x6x3 et un autre de 3x3x3, pour ne laisser aucun reste, il serait possible de découper des cubes de 1x1x1 ou 3x3x3 (nombres entiers uniquement). Ici, on recherche à faire les plus gros cubes, c'est donc 3x3x3 qui est retenu.
Dans le bloc de 6x6x3, on peut découper 4 cubes de 3x3x3 et dans le second bloc de 3x3x3, 1 cube.

Au total, cela fait 5 cubes de taille identique, les plus grands possible et sans reste.

Donc si la cellule contient 6x6x3/3x3x3, la macro devra renvoyer le résultat 5.


L'EXERCICE :

Complétez la macro suivante dans le fichier fourni :
Private Sub CommandButton_defi_Click()
    
    'Votre code ici
    
End Sub
Au clic sur le bouton "Lancer la macro", cette macro devra compléter les cellules en vert (en entrant dans chaque cellule le nombre de cubes en fonction des blocs de la colonne A) :
defi_1.png
defi_1.png (9.99 Kio) Vu 3995 fois
Les résultats attendus sont entrés dans la colonne B (cela vous permettra de vérifier si vos résultats sont corrects).

Si possible, commentez votre macro pour en faciliter la compréhension pour les autres membres !

Le fichier à télécharger (en version xls ou xlsm) :
defi_1.xlsm
(22.3 Kio) Téléchargé 201 fois
defi_1.xls
(47 Kio) Téléchargé 226 fois
PARTAGEZ VOTRE MACRO :

Si vous trouvez une solution fonctionnelle, vous pouvez poster votre macro "CommandButton_defi_Click" à la suite de ce post.


FACULTATIF :

Si vous souhaitez aller plus loin dans le défi, essayez de créer la macro la plus courte possible pour réaliser ce même travail et ajoutez également cette seconde macro dans le même post.
Sébastien
v
vba-new
Passionné d'Excel
Passionné d'Excel
Messages : 3'003
Appréciations reçues : 2
Inscrit le : 13 mai 2009
Version d'Excel : 2010 FR - 2013 FR

Message par vba-new » 28 avril 2013, 15:44

Bonjour à tous,

Voici une solution :
Private Sub CommandButton_defi_Click()

    'Votre code ici
    'explication de l'algorithme :
    '1- on calcule le nombre d'éléments total que contiennent les blocs
    '   ex pour les blocs 8x2x2/2x1x1 : 8*2*2 + 2*1*1 = 34
    '2- on calcule ensuite le plus grand dénominateur commun (PGCD) à toutes les "dimensions" des blocs
    '   dans notre exemple, on cherche le PGCD de 8, 2 et 1 qui sera donc 1
    '3- on utilisera donc 34/(1*1*1)=34 cubes de dimension 1 (1x1x1)

    'explication du code utilisé :
    '1- on remplace les "/" par des "+" et les "x" par des "*" pour obtenir 8*2*2+2*1*1
    '   on utilise ensuite la fonction VBA Evaluate afin d'évaluer le calcul obtenu (ne pas oublier d'ajouter un "=" devant)
    '2- on utilise la fonction Split afin de récupérer toutes les "dimensions" des blocs
    '   ces dimensions sont automatiquement transférées dans une variable tableau sur laquelle on utilisera la fonction GCD (Great Common Divisor)
    '3- il ne reste plus qu'à faire le quotient des valeurs trouvées en 1 et 2
    
    For i = 2 To 8    'boucle sur chaque valeur
        Cells(i, 3) = Evaluate("=" & Replace(Replace(Cells(i, 1), "/", "+"), "x", "*")) / Application.Gcd(Split(Replace(Cells(i, 1), "x", "/"), "/")) ^ 3
    Next i

End Sub
Bien sûr, on peut mettre la boucle sur 1 ligne en utilisant les ":" mais ça revient au même... :D
1 membre du forum aime ce message.
vba-new
Avatar du membre
Mytå
Membre impliqué
Membre impliqué
Messages : 1'536
Inscrit le : 28 novembre 2009
Version d'Excel : Excel 2003, 2007, 2010, 2016

Message par Mytå » 28 avril 2013, 19:04

Salut Sébastien
Option Explicit

Private Sub CommandButton_defi_Click()
'Défi VBA n°1 (cubes)
'Par Mytå, le 28 avril 2013

Dim Bloc() As String, Blocs() As String, Cubes() As Integer
Dim Cel As Range, Expr As String
Dim i As Byte, PGD As Byte, Rep As Long

    For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        ReDim Cubes(0)
        Bloc = Split(Cel, "/")

        For i = 0 To UBound(Bloc)
            Blocs = Split(Bloc(i), "x")
            ReDim Preserve Cubes(UBound(Cubes) + 3)
            Cubes(UBound(Cubes) - 2) = Blocs(0)
            Cubes(UBound(Cubes) - 1) = Blocs(1)
            Cubes(UBound(Cubes)) = Blocs(2)
        Next i

        Expr = ""
        For i = 1 To UBound(Cubes)
            Expr = Expr & Cubes(i) & ","
        Next i

        PGD = Evaluate("=GCD(" & Expr & ")")
        Rep = 0
        For i = 1 To UBound(Cubes) Step 3
            Rep = Rep + Cubes(i) / PGD * Cubes(i + 1) / PGD * Cubes(i + 2) / PGD
        Next i
        Cel.Offset(, 2) = Rep
    Next Cel
    
End Sub
Petite précision sur mon code, il faut remplacer selon les versions d'Excel
        PGD = Evaluate("=PGCD(" & Expr & ")")  'Excel 2003
         PGD = Evaluate("=GCD(" & Expr & ")")    'Excel 2007/2010
J'avais bâti mon code sous Excel 2003, sans tester avec les autres versions.

Mytå
Même des personnes qui étaient très actives auparavant
peuvent soudainement ne plus avoir le goût de participer du tout . . .
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 8'589
Appréciations reçues : 40
Inscrit le : 6 avril 2007
Version d'Excel : 2010

Message par Yvouille » 28 avril 2013, 21:21

Salut Sébastien, Bonjour le Forum,

Voici ma solution.
Option Explicit
Private Sub CommandButton_defi_Click()
Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, p As Integer, q As Long
Dim PPCD As Integer

Application.ScreenUpdating = False

For i = 2 To 8
    Range("A10") = Range("A" & i)
Retour:
    On Error Resume Next
    j = Application.WorksheetFunction.Find("/", Range("A10"))
    k = Application.WorksheetFunction.Find("x", Range("A10"))
    
    If j = 0 And k = 0 Then
        Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = Range("A10")
        Range("A10") = ""
        GoTo Etiquette
    End If
    
    If j = 0 Or k = 0 Then
        n = Application.WorksheetFunction.Max(j, k)
    Else
        n = Application.WorksheetFunction.Min(j, k)
    End If
    
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = Left(Range("A10"), n - 1)
    Range("A10") = Right(Range("A10"), Len(Range("A10")) - n)
    
    j = 0
    k = 0
    GoTo Retour
             
Etiquette:

PPCD = Application.WorksheetFunction.Gcd(Range("A11:A" & Range("A" & Rows.Count).End(xlUp).Row))
    
    For p = 11 To Range("A" & Rows.Count).End(xlUp).Row Step 3
        q = q + ((Cells(p, 1) / PPCD) * (Cells(p + 1, 1) / PPCD) * (Cells(p + 2, 1) / PPCD))
    Next p
    
    Cells(i, 3) = q
    
    Range("A10:A" & Rows.Count).ClearContents
    q = 0
    
Next i

End Sub
Cordialement.
defi_1_Yvouille.xls
(50 Kio) Téléchargé 125 fois
Yvouille


:btres:
j
jgchio
Nouveau venu
Nouveau venu
Messages : 1
Inscrit le : 29 avril 2013
Version d'Excel : 2007

Message par jgchio » 29 avril 2013, 08:07

Option Explicit
Private Sub CommandButton_defi_Click()
' Je nomme arête l'une des 3 dimensions d'un bloc
Dim Str_Blocs As String, Bloc As String, p As Byte, i As Byte, j As Byte, N As Long, Ligne As Byte
Dim Nb_Arêtes As Integer, Pgcd As Integer, Nb_Cubes As Long
Dim T_Arêtes() As Integer ' Tableau des longueurs (sous forme nombre entier) des arêtes de chaque bloc

' On nomme les 3 colonnes de la plage par leur entête
Range("A1").CurrentRegion.CreateNames Top:=True, Left:=False

For Ligne = 1 To Range("Blocs").Cells.Count
    Str_Blocs = Range("Blocs").Cells(Ligne).Value & "/"

    ReDim T_Arêtes(Nb_Blocs(Str_Blocs) * 3)
    ' Recherche du nombre total d'arêtes pour tous les blocs et mise en tableau des valeurs de ces arêtes
    p = 0: Nb_Arêtes = 0
    For i = 1 To Len(Str_Blocs)
        If Mid(Str_Blocs, i, 1) = "x" Or Mid(Str_Blocs, i, 1) = "/" Then
            T_Arêtes(Nb_Arêtes) = Val(Mid(Str_Blocs, p + 1, i - p - 1))
            Nb_Arêtes = Nb_Arêtes + 1
            p = i
        End If
    Next

    ' Recherche du PGCD de toutes les arêtes pour l'ensemble des blocs
    Pgcd = Application.Gcd(T_Arêtes(0), T_Arêtes(1)) ' PGCD des 2 premières arêtes
    For i = 2 To UBound(T_Arêtes)
        Pgcd = Application.Gcd(Pgcd, T_Arêtes(i))
    Next

    ' Calcul du nombre de cubes
    Nb_Cubes = 0
    For i = 1 To UBound(T_Arêtes) / 3
        N = 1
        For j = 0 To 2
            N = N * (T_Arêtes((i - 1) * 3 + j) / Pgcd)
        Next
        Nb_Cubes = Nb_Cubes + N
    Next
    
    Range("Vos_résultats").Cells(Ligne) = Nb_Cubes
Next Ligne
    
End Sub

Public Function Nb_Blocs(Str_Blocs) As Byte
Dim i As Byte
For i = 1 To Len(Str_Blocs)
    If Mid(Str_Blocs, i, 1) = "/" Then Nb_Blocs = Nb_Blocs + 1
Next
End Function
Je vous mets ma solution en pièce jointe.
Cordialement
JG CHIO
defi_1_JG-CHIO.xls
(55 Kio) Téléchargé 121 fois
Avatar du membre
eriiic
Passionné d'Excel
Passionné d'Excel
Messages : 8'684
Appréciations reçues : 292
Inscrit le : 7 février 2010
Version d'Excel : 2010fr

Message par eriiic » 30 avril 2013, 13:43

Bonjour,

et une participation de plus.
J'étais parti sur un truc plus compliqué : nombre mini de cubes avec des cubes les plus gros possibles pfffff...
Private Sub CommandButton_defi_Click()
    For Each c In [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 1)
        nbCubes = 0
        bloc = Split(c, "/") ' découpage des blocs
        For i = 0 To UBound(bloc)
            [F1:F3].Offset(, i) = Application.Transpose(Split(bloc(i), "x")) ' tableau des dimensions sur feuille
        Next i
        pgcd = Evaluate("pgcd(" & [F1].CurrentRegion.Address & ")") ' taille bloc max
        For i = 0 To UBound(bloc)
            nbCubes = nbCubes + Evaluate("product(" & [F1:F3].Offset(, i).Address & ")") / pgcd ^ 3 ' nombre de cubes
        Next i
        c.Offset(, 2) = nbCubes
        [F1].CurrentRegion.ClearContents
    Next c
End Sub
En nombre minimum de ligne (1 ligne ;-)) :
Private Sub defi_mini()
    For Each c In [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 1): nbCubes = 0: bloc = Split(c, "/"): For i = 0 To UBound(bloc): [F1:F3].Offset(, i) = Application.Transpose(Split(bloc(i), "x")): Next i: For i = 0 To UBound(bloc): nbCubes = nbCubes + Evaluate("product(" & [F1:F3].Offset(, i).Address & ")") / Evaluate("pgcd(" & [F1].CurrentRegion.Address & ")") ^ 3: Next i: c.Offset(, 2) = nbCubes: [F1].CurrentRegion.ClearContents: Next c
End Sub
defi_1.xls
(44.5 Kio) Téléchargé 103 fois
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.
(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'726
Appréciations reçues : 2
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 30 avril 2013, 14:24

Bonjour

En voulant tester la macro sur 2010 et 2013 je me suis aperçu qu'elle ne fonctionnait pas sur ces versions
Donc modification du code qui vérifie la version :
Option Explicit

Sub Decoupe()
Dim I As Integer, K As Integer    ' Variable de boucle
Dim J As Long                     ' Variable de boucle pour les lignes dans la page
Dim NombreCube As Long            ' Nombre de cube dans chaque bloc
Dim Bloc                          ' Tableau contenant le nombre de bloc
Dim Dimension                     ' Tableau contenant toutes les dimensions
Dim Arete As Integer              ' Calcul de l'arête maxi du cube
Dim Total As Long                 ' Nombre de cube total dans tous les blocs

  For J = 2 To Range("A" & Rows.Count).End(xlUp).Row            ' Pour toute les lignes
    Dimension = Split(Replace(Range("A" & J), "/", "x"), "x")   ' On place dans un tableau toutes les dimensions de tous les blocs
    If Val(Application.Version) >= 12 Then                      ' Vérification de la version Excel
      Arete = Application.Gcd(Dimension)                        ' Si version 2007 ou plus
    Else
      Arete = Evaluate("PGCD(" & Join(Dimension, ",") & ")")    ' Meilleur moyen d'obtenir le PGCD (pas natif en 2003)
    End If
    Total = 0                                                   ' Initialise la variable
    Bloc = Split(Range("A" & J), "/")                           ' Décompose en bloc
    For I = 0 To UBound(Bloc)                                   ' Pour chaque bloc
      Dimension = Split(Bloc(I), "x")                           ' Les dimensions de ce bloc
      NombreCube = Dimension(0) / Arete                         ' La 1ère dimension donne une quantité de bloc
      For K = 1 To UBound(Dimension)
        NombreCube = NombreCube * Dimension(K) / Arete          ' Cette quantité est multipliée par le nombre de bloc que l'on peut ontenir pour chaque dimension
      Next K
      Total = Total + NombreCube                                ' On totalise le nombre de cube
    Next I
    Range("C" & J) = Total                                      ' On inscrit ce total
  Next J
End Sub
Normalement compatible 2003 - 2010 - 2013
Banzai64 defi_1 V001.xls
(54 Kio) Téléchargé 121 fois
Image
Avatar du membre
paritec
Passionné d'Excel
Passionné d'Excel
Messages : 3'495
Appréciations reçues : 262
Inscrit le : 7 juin 2011
Version d'Excel : W10 - 2003 FR - 2010 FR

Message par paritec » 30 avril 2013, 17:26

Bonjour Sebastien et tous,
ma version Paritec
Option Explicit

Private Sub CommandButton_defi_Click()
    Dim i&, x, y, n&, res, var, aa, l&, d#, resu&, a&
    With Sheets("Défi")
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            ReDim var(l)
            x = Split(.Cells(i, 1), "/")
            For a = 0 To UBound(x)
                y = Split(x(a), "x")
                For n = 0 To UBound(y)
                    ReDim Preserve var(l): var(l) = y(n): l = l + 1
                Next n
            Next a
            l = 0
            d = Application.WorksheetFunction.Gcd(var)
            For a = 0 To UBound(x)
                y = Split(x(a), "x")
                For n = 0 To UBound(y)
                    If res = 0 Then res = (CDbl(y(n)) / d) Else res = res * (CDbl(y(n)) / d)
                Next n
                resu = resu + res
                res = 0
            Next a
            .Cells(i, 3) = resu: resu = 0
        Next i
    End With
End Sub
a+
papou :)
defi_Paritec.xlsm
(24.38 Kio) Téléchargé 91 fois
1 membre du forum aime ce message.
Des bonnes explications et des petits fichiers représentatifs vont nous aider à vous aider !!!!
Avatar du membre
Game Over
Membre dévoué
Membre dévoué
Messages : 780
Appréciations reçues : 2
Inscrit le : 9 mars 2013
Version d'Excel : 2016 EN
Contact :

Message par Game Over » 1 mai 2013, 01:11

Salut,

voici ma proposition...
Option Explicit
Dim myRange As Range, derLig As Integer, a As Integer, NbB As Integer, myValue As String, b As Integer, myRec As String
Dim Tablo As Variant, mysplit As Variant, c As Integer, d As Integer, mySplit2 As Variant, myGCD As Integer
Dim ii As Long, jj As Long

Private Sub CommandButton_defi_Click()
Application.ScreenUpdating = False
derLig = Range("A" & Rows.Count).End(xlUp).Row

For a = 2 To derLig
    
    Set myRange = Cells(a, 1)
    
    myValue = myRange.Value

    NbB = 0
    For b = 1 To Len(myValue)
        myRec = Mid(myValue, b, 1)
        If myRec = "/" Then NbB = NbB + 1
    Next b
    
    NbB = NbB + 1

    ReDim Tablo(NbB)
    If NbB = 1 Then
        Tablo(1) = myRange.Value
    Else
        mysplit = Split(myRange.Value, "/")
        For c = 1 To NbB
            Tablo(c) = mysplit(c - 1)
        Next c
    End If

    For d = 1 To UBound(Tablo)
        mySplit2 = Split(Tablo(d), "x")
        Cells(d, 8) = mySplit2(0)
        Cells(d, 9) = mySplit2(1)
        Cells(d, 10) = mySplit2(2)
    Next d
    myGCD = Application.WorksheetFunction.Gcd(Cells(1, 8).CurrentRegion)
    
   d = 1
    ii = 0
    jj = 0
    Do Until IsEmpty(Cells(d, 8))
        ii = Cells(d, 8) / myGCD * Cells(d, 9) / myGCD * Cells(d, 10) / myGCD
        jj = jj + ii
        d = d + 1
    Loop
    
    myRange.Offset(, 2) = jj
 
    Set Tablo = Nothing
    Cells(1, 8).CurrentRegion.ClearContents

Next a

Application.ScreenUpdating = True

End Sub
Quand est ce que les résultats seront publiés ?
D fiXed.xlsm
(25.71 Kio) Téléchargé 111 fois
1 membre du forum aime ce message.
Avatar du membre
Sébastien
Administrateur
Administrateur
Messages : 1'954
Appréciations reçues : 154
Inscrit le : 4 décembre 2004
Version d'Excel : 2013
Téléchargements : Mes applications
Contact :

Message par Sébastien » 1 mai 2013, 15:27

Bonjour à tous,

Les macros sont maintenant dévoilées ...

L'astuce ici pour réaliser une macro assez courte et sans trop de tableaux était d'utiliser Evaluate pour calculer le résultat (en transformant par exemple 81x72x99/36x45x18 en 81*72*99+36*45*18, voir plus bas).

Mais l'important est avant tout d'avoir réussi à relever le défi avec une macro fonctionnelle. Je suis d'ailleurs bien content que la plupart d'entre-vous n'y ait pas pensé, ça nous permet d'avoir maintenant un beau choix de macros bien différentes ce qui est beaucoup plus intéressant/instructif (et c'est aussi le but recherché) :wink:

Bravo à tous les participants :bien:

De mon côté, je vous propose différentes solutions :

Résultat (version normale) :
Private Sub CommandButton_defi_Click()
    
    For ligne = 2 To Range("A1").End(xlDown).Row
        
        'Côté du cube = plus grand diviseur commun avec la fonction GCD
         cote = WorksheetFunction.Gcd(Split(Replace(Cells(ligne, 1), "x", "/"), "/"))
        
        'Calcul du résultat = somme de la multiplication des 3 dimensions de chaque bloc, le tout divisé par le côté au cube (comme si l'on divisait chaque dimension par le côté)
         Cells(ligne, 3) = Evaluate(Replace(Replace(Cells(ligne, 1), "x", "*"), "/", "+")) / cote ^ 3
        
    Next
    
End Sub
Résultat (version réduite) :
Private Sub CommandButton_defi_Click()
    For l = 2 To 8
        Cells(l, 3) = Evaluate(Replace(Replace(Cells(l, 1), "x", "*"), "/", "+")) / WorksheetFunction.Gcd(Split(Replace(Cells(l, 1), "x", "/"), "/")) ^ 3
    Next
End Sub
Résultat (version détaillée) :
Private Sub CommandButton_defi_Click()
    
    For ligne = 2 To Range("A1").End(xlDown).Row
        
        'Cellule à tester
         cellule = Cells(ligne, 1)
        
        'Remplacement des "x" par des "/" (pour avoir par exemple : 16/8/12/8/20/8)
         liste = Replace(cellule, "x", "/")
        
        'Entrée de ces valeurs dans un tableau
         tab_liste = Split(liste, "/")
        
        'Côté du cube = plus grand diviseur commun avec la fonction GCD
         cote = WorksheetFunction.Gcd(tab_liste)
        
        'Formule (pour avoir par exemple : 16*8*12+8*20*8)
         formule = Replace(Replace(cellule, "x", "*"), "/", "+")
        
        'Résultat de la formule divisé par le côté au cube (comme si l'on avait divisé chaque valeur par le côté)
         Cells(ligne, 3) = Evaluate(formule) / cote ^ 3
        
    Next
    
End Sub

Autre résultat sans utiliser Evaluate (version normale) :
Private Sub CommandButton_defi_Click()

    For ligne = 2 To Range("A1").End(xlDown).Row
        
        cote = WorksheetFunction.Gcd(Split(Replace(Cells(ligne, 1), "x", "/"), "/")) 'Plus grand diviseur commun
         tab_blocs = Split(Cells(ligne, 1), "/") 'Liste des blocs dans un tableau
         resultat = 0
        
        For i = 0 To UBound(tab_blocs)
            tab_bloc = Split(tab_blocs(i), "x")  '3 dimensions du bloc dans un tableau
             resultat = resultat + tab_bloc(0) * tab_bloc(1) * tab_bloc(2) / cote ^ 3 'Nombre de cubes pour ce bloc
         Next
        
        Cells(ligne, 3) = resultat 'Affichage du résultat
        
    Next
    
End Sub
Autre résultat sans utiliser Evaluate (version réduite) :
Private Sub CommandButton_defi_Click()
    For l = 2 To 8
        For i = 0 To UBound(Split(Cells(l, 1), "/"))
            Cells(l, 3) = Cells(l, 3) + Split(Split(Cells(l, 1), "/")(i), "x")(0) * Split(Split(Cells(l, 1), "/")(i), "x")(1) * Split(Split(Cells(l, 1), "/")(i), "x")(2) / WorksheetFunction.Gcd(Split(Replace(Cells(l, 1), "x", "/"), "/")) ^ 3
        Next
    Next
End Sub

Autre résultat sans utiliser GCD, compatible avec les vieilles versions d'Excel (version normale) :
Private Sub CommandButton_defi_Click()
    
    For ligne = 2 To Range("A1").End(xlDown).Row
        
        'Liste des valeurs
         tab_liste = Split(Replace(Cells(ligne, 1), "x", "/"), "/")
        
        'Côté du cube = plus grand diviseur commun
         For nb = 1 To 100
            test = True
            For i = 0 To UBound(tab_liste)
                If tab_liste(i) Mod nb <> 0 Then test = False
            Next
            If test Then cote = nb
        Next
        
        'Calcul du résultat
         Cells(ligne, 3) = Evaluate(Replace(Replace(Cells(ligne, 1), "x", "*"), "/", "+")) / cote ^ 3
        
    Next
    
End Sub
Autre résultat sans utiliser GCD, compatible avec les vieilles versions d'Excel (version réduite) :
Private Sub CommandButton_defi_Click()
    For l = 2 To 8
        For n = 1 To 100
            test = True
            For i = 0 To UBound(Split(Replace(Cells(l, 1), "x", "/"), "/"))
                If Split(Replace(Cells(l, 1), "x", "/"), "/")(i) Mod n <> 0 Then test = False
            Next
            If test Then Cells(l, 3) = Evaluate(Replace(Replace(Cells(l, 1), "x", "*"), "/", "+")) / n ^ 3
        Next
    Next
End Sub
1 membre du forum aime ce message.
Sébastien
Répondre Sujet précédentSujet suivant