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 SubMerci 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 SubBonjour 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 SubJe 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" 'ValeurSlts,
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.
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 selectIl 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.
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_ligIl me faudrait modifier quoi à mon code ?
Merci encore
PS : Pour info le fichier ci-joint avec nouvelle macro
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 MCdlt
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= tab1Merci 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+
Merci beaucoup galopin01, la macro est top et super efficace
Bonne soirée
A+
