VBA Select Case

Bonjour,

J'ai une macro avec des conditions sous la forme de If-ElseIf-Else, mais elle est très longue et elle met du temps à s'actualiser, et en plus elle ne fonctionne pas toujours. J'ai entendu dire qu'avec une macro "Select Case", je pourrais gagner du temps, mais je ne trouve pas la solution pour créer la macro. Je vous donne une partie de ma macro ci-dessous, que j'aimerais changer e "Select Case" :

Sub test()

For i = 10 To 5000

If Cells(i, 6) = "ARMOIRE" And Cells(i, 15) = "Dose 10" Then
Cells(i, 23) = 200
ElseIf Cells(i, 6) = "MEUBLE" And Cells(i, 15) = "Dose 12,5" Then
Cells(i, 23) = 200
ElseIf Cells(i, 6) = "PLACARD" And Cells(i, 15) = "Dose 80" Then
Cells(i, 23) = 40
ElseIf Cells(i, 6) = "ARMOIRE" And Cells(i, 15) = "Dose 2,5" Then
Cells(i, 23) = 1
ElseIf Cells(i, 6) = "ETAGERE" And Cells(i, 15) = "Dose 50" And Cells(i, 19) <= 17.9 Then
Cells(i, 23) = 75
ElseIf Cells(i, 6) = "ETAGERE" And Cells(i, 15) = "Dose 50" And Cells(i, 19) <= 19.9 Then
Cells(i, 23) = 65
ElseIf Cells(i, 6) = "ETAGERE" And Cells(i, 15) = "Dose 50" And Cells(i, 19) > 19.9 Then
Cells(i, 23) = 50
ElseIf Cells(i, 6) = "MEUBLE" And Cells(i, 15) = "20 Kg" And Cells(i, 13) = "DOS" Then
Cells(i, 23) = 50
ElseIf Cells(i, 6) = "ARMOIRE" And Cells(i, 15) = "20 Kg" And Cells(i, 13) = "KG" Then
Cells(i, 23) = 1000

Else
Cells(i, 23) = "#NA"
End If
Next

End Sub

Merci pour vos retours.

Bonjour,

Pourquoi 5000 ?

Sub test2()

Dim I As Integer

    Application.ScreenUpdating = False
    With ActiveSheet

        For I = 10 To 5000

            Select Case .Cells(1, 6)
                   Case "ARMOIRE"
                        Select Case .Cells(I, 15)
                               Case "Dose 10"
                                    .Cells(I, 23) = 200
                               Case "Dose 2,5"
                                    .Cells(I, 23) = 1
                               Case "20 Kg"
                                    If .Cells(I, 13) = "KG" Then .Cells(I, 23) = 1000
                        End Select
                   Case "MEUBLE"
                        Select Case .Cells(I, 15)
                               Case "Dose 12,5"
                                    .Cells(I, 23) = 200
                               Case "20 Kg"
                                    If .Cells(I, 13) = "DOS" Then .Cells(I, 23) = 50
                        End Select

                   Case "PLACARD"
                        If .Cells(I, 15) = "Dose 80" Then .Cells(I, 23) = 40

                   Case "ETAGERE"

                         If .Cells(I, 15) = "Dose 50" Then
                            Select Case .Cells(I, 19)
                                   Case Is <= 17.9
                                        .Cells(I, 23) = 75
                                   Case Is > 17.9, Is <= 19.9
                                        .Cells(I, 23) = 65
                                   Case Else
                                        .Cells(I, 23) = 50
                            End Select
                        End If

                   Case Else

                      .Cells(I, 23) = "#NA"

            End Select

        Next

   End With
   Application.ScreenUpdating = True

End Sub

Bonjour AVbr12,

Un Select Case serait la solution parfaite face à un If-ElseIf-Else.. Cependant dans ton cas tu as une double condition à chaque fois donc cela risque de devenir à nouveau un gloubi-boulga de Select case..

Je propose une solution différente, qui se veux facilement modulable dans le cas ou tu souhaiterais ajouter de nouvelle combinaison, meubles, etc.

A tester:

Sub test()

NBItems = 7 'Nombre d'items différents
NBItems = NBItems - 1

Dim T(NBItems, 2) As String

T(0, 0) = "ARMOIRE" 'Item
T(0, 1) = "Dose 10" 'Critère
T(0, 2) = "200" 'Valeur

T(1, 0) = "MEUBLE" 'Item
T(1, 1) = "Dose 12,5" 'Critère
T(1, 2) = "200" 'Valeur

T(2, 0) = "PLACARD" 'Item
T(2, 1) = "Dose 80" 'Critère
T(2, 2) = "40" 'Valeur

T(3, 0) = "ARMOIRE" 'Item
T(3, 1) = "Dose 2,5" 'Critère
T(3, 2) = "1" 'Valeur

T(4, 0) = "ETAGERE" 'Item
T(4, 1) = "Dose 50" 'Critère
T(4, 2) = "75" 'Valeur

T(5, 0) = "MEUBLE" 'Item
T(5, 1) = "20 Kg" 'Critère
T(5, 2) = "50" 'Valeur

T(6, 0) = "ARMOIRE" 'Item
T(6, 1) = "20 Kg" 'Critère
T(6, 2) = "1000" 'Valeur

For i = 10 To 5000
    For a = 0 To NBItems
        If Cells(i, 6) = T(a, 0) And Cells(i, 15) = T(a, 1) Then
            Cells(i, 23) = T(a, 2)
            GoTo exit_boucle
        End If
    Next a
    Cells(i, 23) = "#NA"
exit_boucle:
Next i

End Sub

Je crée un tableau qui contiendrais toutes les combinaisons possible avant de les tester dans tes cellules. Pour ajouter une nouvelle combinaison il suffirait d'ajouter +1 à la variable NBItems au début de la procédure, et coller un nouvelle itération:

T(7, 0) = "NOUVEAU MEUBLE" 'Item
T(7, 1) = "300 Kg" 'Critère
T(7, 2) = "123456" 'Valeur

Slts,

Gabin

Bonjour,

Sinon avec une formule, à mettre dans la première cellule et à tirer vers le bas

=SI(OU(ET($F10="ARMOIRE";$O10="Dose 10");ET($F10="MEUBLE";$O10="Dose 12,5"));200;
SI(ET($F10="PLACARD";$O10="Dose 80");40;
SI(ET($F10="ARMOIRE";$O10="Dose 2,5");1;
SI(ET($F10="ETAGERE";$O10="Dose 50";$S10<=17,9);75;
SI(ET($F10="ETAGERE";$O10="Dose 50";$S10<=19,9);65;
SI(OU(ET($F10="ETAGERE";$O10="Dose 50";$S10>=19,9);ET($F10="MEUBLE";$O10="20 Kg";$M10="DOS"));50;
SI(ET($F10="ARMOIRE";$O10="Dose 2,5";$O10="20 Kg";$M10="KG");1000;"#NA")))))))

Cdlt

Bonjour,

Vous vous évertuez à présenter des questions sans fichier. Et vous obtenez des réponses non satisfaisantes.

Mais une macro est une pièce d'horlogerie : Sans fichier il y a peu de chance (sauf si le cas est très simple) de tomber par hasard sur la bonne solution.

De plus certains répondeurs (dont je suis) s'abstiennent de répondre à des questions sans fichier joint. Si vous ne vous donnez pas la peine de confectionner un classeur modèle il n'y a pas de raison qu'on se fatigue à votre place...

Il n'y a aucune raison légitime de ne pas présenter de classeur cible avec une demande de VBA.

Même la confidentialité dont se prévalent les ignorants est une absurdité : Une fois que vous avez enlevez les noms de vos employeurs et remplacé tous les "E" par des "A" et tous les 2 par des 5 votre fichier n'a plus rien de confidentiel. Et cela ne vous prendrait surement pas plus de 5 minutes à fournir la feuille utile.

Il n'y a pas que les If et les Select case dans la programmation : Le travail sur les Array est en moyenne 20 fois plus rapide que le travail comme vous le suggérez.

Et celui sur avec des Dictionnary est encore plus instantané...

Bon ben... Si vous insistez à vouloir perdre votre temps de cette manière :

Bon courage.

Merci à tous pour vos réponses.

Effectivement Galopin01, ça serait mieux avec mon fichier. Je le rajoute en pièce jointe, il y a ma macro entière dedans. Des fois la macro va bien fonctionner et rapidement, alors que dés fois elle ne fonctionne pas. Donc je me dis que le If-ElseIf-Else n'est pas le plus optimisé, j'aimerais quelque chose de rapide.

Merci pour vos retours.

22classeur1-test.xlsm (264.11 Ko)

Bonjour,

Si vous utilisez un tableau structuré il est inutile de lui attribuer des lignes vides (vous en avez 3995 pour de 2734 utilisées)

Il y a actuellement 616 possibilités différentes, il me semble plus opportun de créer une liste de toutes ces combinaisons dans une autre feuille (que vous complèterez, s'il y en a d'autres à venir), puis d'appliquer une formule qui va recherche la valeur à appliquer.

Formule en W5 de la feuille 1 (formule matricielle à valider avec CTRL + SHIFT + ENTREE)

=INDEX(Tableau_Liste[#Tout];
EQUIV(1;
(Tableau_Liste[[#Tout];[6]]=TableauMOL[[#Cette ligne];[6]])*
(Tableau_Liste[[#Tout];[13]]=TableauMOL[[#Cette ligne];[13]])*
(Tableau_Liste[[#Tout];[15]]=TableauMOL[[#Cette ligne];[15]])*
(Tableau_Liste[[#Tout];[19]]=TableauMOL[[#Cette ligne];[19]]);0);5)

Cela me semble plus facile à maintenir, puis pas de code VBA.

Cdlt

Bonjour à tous,

Au cas où, l'utilisation du select case correspondante serait la suivante :

select case true
    case condition1 and condition2
        instrK1
    case condition3 and condition4
        instrK2
    '.....
    case else: instrKn
end select

Il y a évaluation de l'expression booléenne de chacun des cas, les uns à la suite des autres. Il faut donc faire attention à l'ordre d'écriture des cas (dès qu'une expression est vraie, on sort du select case).

Ce select case true est notamment pratique pour des conditions multiples ou avec l'opérateur Like par exemple.

Cdlt,

Arturo83 merci pour votre réponse.

Concernant le tableau, le fichier se met à jour tout les jours, et donc c'est possible qu'il y est des lignes supplémentaires.

Comment avez-vous fait pour trouver les 616 possibilités différentes. Et par rapport à ses possibilités, certaines combinaisons ont besoin de la colonne "S"; alors que d'autres non. Étant donné que le fichier change tout les jours, la colonne "S" qui définit le "poids" me ferait rajouter une infinité de combinaisons sur le tableau liste.

Par exemple, si je prends "PLACARD"; "1.5 Millions de Bois"; "<10"; "<>DE"; ça me ferait une infinité de combinaisons, étant donné que tout les résultats inférieurs à 10 et différents de DE sont une combinaison. C'est pour ça que créer une liste est très compliqué je trouve.

Effectivement je n'avais intégré le pays, ce qui fait que par exemple: pour un même pays avec une quantité <=17.9 on aura des résultats différents, donc difficile de pouvoir répondre sans comprendre à quoi correspond cette valeur en colonne 23, ou comment elle est évaluée.

avbr12

Cdlt

Merci à tous pour vos réponses, je suis parti sur un select case, un peu long à écrire mais il a l'air de fonctionner rapidement.

J'avais une dernière question : j'aimerais que ma macro traite jusqu'à la dernière cellule non vide du tableau, car elle traite jusqu'à la fin du tableau, y compris les cellules vides ?

der_lig = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To der_lig

Il me faudrait modifier quoi à mon code ?

Merci encore

PS : Pour info le fichier ci-joint avec nouvelle macro

13classeur1-testvf.xlsm (269.36 Ko)

Le problème, c'est que vous utilisez un tableau structuré avec une plage définie alors que des lignes sont vides, votre recherche de ligne prend la dernière ligne du tableau structuré vide ou pas.

Le plus simple est de convertir le tableau structuré en plage de recherche la dernière ligne sur une colonne autre que la 6, puis de reconvertir en tableau structuré à la fin, si vous le souhaitez.

votre début de code:

    Dim Der_Lig As Long
    On Error Resume Next
    'convertit le tableau structuré "TableauMOL" en plage
    Worksheets("Feuil1").ListObjects("TableauMOL").Unlist
    Der_Lig = Range("M" & Rows.Count).End(xlUp).Row 'on cherche la dernière ligne sur la colonne M

Cdlt

Salut

Tout d'abord il faut savoir comment est alimenté le tableau, tu n'as pas besoin de prévoir des lignes vides puisque tu travailles avec un tableau structuré. Dans le code qui alimente le tableau il faut que tu ajoutes une ligne avec une instruction du type : Range("TableauMOL").ListObject.ListRows.Add Ensuite tu écris les données dans la ligne exemple : Range("TableauMOL").ListObject.ListRows(Range("TableauMOL").ListObject.ListRows.Count).Range(6) = "ETAGERE".

Voilà un fois le code qui aliment le tableau structuré refait il faut redimensionner ton TS manuellement pour supprimer les lignes vides. Ensuite peut-être que de travailler sur un tableau en mémoire te fera encore gagner un peu de temps.

    Dim tab1
    Dim Counter As Long

    tab1 = Range("TableauMOL").ListObject.DataBodyRange.Value
    For Counter = LBound(tab1) To UBound(tab1)
        Select Case tab1(Counter, 6)
            Case "ETAGERE"
                Select Case tab1(Counter, 15)
'...
'...
'...
'...
Range("TableauMOL").ListObject.DataBodyRange.Value= tab1

Merci Arturo83, mais comment fait-on pour reconvertir en tableau structuré ?

Merci Jean Paul pour t'as réponse, c'est un fichier qui change tout les jours donc le nombre de lignes varie, c'est pour ça qu'il y a des lignes vides.

Cdlt

Connaissant la dernière ligne "Der_Lig" (vu au début de la macro)

ajoutez à la fin

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A4:W" & Der_Lig), , xlYes).Name = "TableauMOL"

Autre solution... Avec des Array : Vous remarquerez qu'a aucu moment on ne travaille sur le tableau. On stocke seulement les données en mémoire et on les travaille puis (dernière ligne de la macro) on transfère le tableau dans Excel. Même pas besoin de ScreenUpdating ni de figer quoi que ce soit : La macro est instantanée...

Nota : J'ai rebaptisé votre tableau "TMOL"

Important : Dans les Select Case vos propositions (Case) doivent être ordonnées : Vous ne pouvez pas passez du "SAC 1 kG" au "SAC 3 kG" et au "SAC 5 kG" puis revenir au "Sac 1, 3..."

Select Case ne repasse pas les plats comme If qui évalue tout ce que vous lui passez...

A+

35avbr12-vg.xlsm (241.87 Ko)

Merci beaucoup galopin01, la macro est top et super efficace

Bonne soirée

A+

Rechercher des sujets similaires à "vba select case"