paramétrer select case via des listes

[Hieu]

Bonjour,

Je souhaite paramétrer mes valeurs de select case via des listes afin d'optimiser un programme. Je n'ai pas trouvé de réponses (désolé si je rouvre un sujet déjà ouvert). Voici un exemple du code que je souhaiterai réaliser (qui ne marche pas, naturellement) :

Sub test_select_case()
liste1 = Array(1, 2, 4, 7)
liste2 = Array(3, 5, 6)
For i = 1 To 10
Select Case i
Case liste1
Range("b1").Offset(i, 0) = "liste1"
Case liste2
Range("b1").Offset(i, 0) = "liste2"
End Select
Next i
End Sub

Merci par avance de vos réponses !
Hieu.

 

[bbb38]

Re : paramétrer select case via des listes

Bonjour Hieu, le forum,
Comme tu indiques les valeurs de tes listes dans ton code, je te propose une solution dans le fichier ci-joint, en espérant que celle-ci te permettra de solutionner ton problème.
Cordialement,
Bernard

 

[Hieu]

Re : paramétrer select case via des listes

Bonjour Bernard,
merci pour ta réponse.
Malheureusement, ce n'est pas ce que je cherche. Le code que j'ai initialement ressemble à ceci :

Sub test_select_case()
For i = 1 To 10
Select Case i
Case 1, 2, 4, 7
call toto1()
Case 3, 5, 6
call toto2()
End Select
Next i

For i = 1 To 10
Select Case i
Case 1, 2, 4, 7
call toto3()
Case 3, 5, 6
call toto4()
End Select

' ... etc
Next i
End Sub



D'où mon intérêt à créer des listes sur les "case"
Merci d'avance,
Hieu.

 

[Hieu]

Re : paramétrer select case via des listes

Bonjour Bernard,
merci pour ta réponse.
Malheureusement, ce n'est pas ce que je cherche. Le code que j'ai initialement ressemble à ceci :

Sub test_select_case()
For i = 1 To 10
Select Case i
Case 1, 2, 4, 7
call toto1()
Case 3, 5, 6
call toto2()
End Select
Next i

For i = 1 To 10
Select Case i
Case 1, 2, 4, 7
call toto3()
Case 3, 5, 6
call toto4()
End Select

' ... etc
Next i
End Sub



D'où mon intérêt à créer des listes sur les "case"
Merci d'avance,
Hieu.

 

[eriiic]

Re : paramétrer select case via des listes

Bonjour,

une proposition :

Sub test_select_case()
    Dim cas, dictCas, i As Long
    
    cas = Array(0, 1, 1, 2, 1, 2, 1, 2)   ' de 0 à 7 : cas à appliquer
    Set dictCas = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(cas)
        dictCas(i) = cas(i)
    Next i


    For i = 1 To 10
        Select Case dictCas(i)
        Case 1
            Stop 'Call toto1
        Case 2
            Stop 'Call toto2
        End Select
    Next i
End Sub

Pour plus de clarté tu peux remplacer 1, 1, 2, 1, 2, 1, 2 par des textes "groupe1" ou plus parlants pour toi et :
Case "groupe1"
eric

 

[Hieu]

Re : paramétrer select case via des listes

Bonjour Eric,
Merci pour cette proposition. Cela fonctionne; mais ce n'est pas totalement ce que je cherche. Je souhaite optimiser la macro telle qu'elle soit lisible par un autre utilisateur (milieu professionnel).

Hieu.

PS :
question annexe : comment faites-vous pour écrire la macro dans un carré ??

 

[eriiic]

Re : paramétrer select case via des listes

Bonjour,

Je ne comprend pas trop ta réponse.
Ca fait ce que tu demandes... Qu'est-ce qui est illisibles ????
Et tu lis tout, tu peux mettre Case liste1 au lieu de Case 1, franchement je ne vois pas.

Pour taguer 'code' il faut aller en mode avancé
eric

 

[Hieu]

Re : paramétrer select case via des listes

Bonjour,

Pour les listes,
il peut y avoir énormément de valeur. Si je faisais :

cas = Array(0, 1, 1, 2, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 1, 2)

Il ne serait pas aisé de retrouver à quelle liste appartient la valeur 17 par exemple.

Merci pour le tag
Hieu.

 

[eriiic]

Re : paramétrer select case via des listes

Bonjour,

Ah ok.
Et bien tu peux l'écrire sous cette forme :

Sub test_select_case()
    Dim cas, dictCas, i As Long
    Dim liste(1 To 2), j As Long


    liste(1) = Array("groupe1", 1, 2, 4, 7)
    liste(2) = Array("groupe2", 3, 5, 6)


    Set dictCas = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(liste)
        For i = 1 To UBound(liste(j))
            dictCas(liste(j)(i)) = liste(j)(0)
        Next i
    Next j


    For i = 1 To 7
        Select Case dictCas(i)
        Case "groupe1"
            Stop    'Call toto1
        Case "groupe2"
            Stop    'Call toto2
        End Select
    Next i
End Sub

eric

 

[Lone-wolf]

Re : paramétrer select case via des listes

Bonjour à tous et bonnes fêtes de Pâques

j'ai peut-être mal compris, alors, d'avance toutes mes excuses.

Avec cette macro

Sub test()
Dim liste(1 To 2) As Variant
Dim k, x As Integer

liste1 = Array("1", "2", "4", "7")
liste2 = Array("3", "5", "6", "9")
k = 2
On Error Resume Next
With Feuil1
For x = 0 To 7
Select Case .Range("b" & k)
Case Is = ""
.Range("b" & k) = liste1(0)
.Range("b" & k + 1) = liste1(1)
.Range("b" & k + 2) = liste1(2)
.Range("b" & k + 3) = liste1(3)
End Select
Select Case .Range("d" & k)
Case Is = ""
.Range("d" & k) = liste2(0)
.Range("d" & k + 1) = liste2(1)
.Range("d" & k + 2) = liste2(2)
.Range("d" & k + 3) = liste2(3)
End Select
Next x
End With
End Sub

J'ai obtenu ce résultat (en image)




A+

 

[Hieu]

Re : paramétrer select case via des listes

@Eric,

Merci,
C'est c'que je cherchais !
Pour info,
lorsque tu écris :

Dim cas, dictCas, i As Long

Seul i est de type long, c'est normal ? Ca n'influe pas sur le code (perso, je n'déclare jamais mes variables ^^)

Question annexe : Y a-t-il une façon d'écrire quelque chose comme ça ?

Sub test_select_case()
    Dim cas, dictCas, i As Long
    Dim liste(1 To 2), j As Long


    liste(1) = Array("groupe1", 1 to 2, 4, 7 to 13)
    liste(2) = Array("groupe2", 3, 5 to 6, 14 to 35)


    Set dictCas = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(liste)
        For i = 1 To UBound(liste(j))
            dictCas(liste(j)(i)) = liste(j)(0)
        Next i
    Next j


    For i = 1 To 7
        Select Case dictCas(i)
        Case "groupe1"
            Stop    'Call toto1
        Case "groupe2"
            Stop    'Call toto2
        End Select
    Next i
End Sub

@Lone-wolf,
C'est pas du tout çà ^^ Les listes, je les ai.Je ne cherche pas à les ressortir. Par contre, comment fais-tu pour écrire ton code en couleur ?

Merci à tous les deux,
Hieu.

 

[eriiic]

Re : paramétrer select case via des listes

Seul i est de type long, c'est normal ?

Oui, les autres doivent être Variant et c'est le type par défaut

Question annexe : Y a-t-il une façon d'écrire quelque chose comme ça ?

    liste(1) = Array("groupe1", 1 to 2, 4, 7 to 13)

Oui, si tu construits la partie analyse de la syntaxe de la saisie.
Tu as juste un split à faire pour avoir les bornes inf et sup de la boucle à ajouter

 

[Lone-wolf]

Re : paramétrer select case via des listes

Re Hieu

comment fais-tu pour écrire ton code en couleur ?

CODE=VBA
LE CODE
/CODE


A+

 

[Hieu]

Re : paramétrer select case via des listes

@Eric,

Pourrais-tu m'envoyer un bout de code ?
Ca parait toujours simple, quand on sait faire

Avant d'ouvrir ce post, je n'connaissais pas

CreateObject("Scripting.Dictionary")
UBound(liste)

Merci ^^


@Lone-wolf: Merci !

 

[eriiic]

Re : paramétrer select case via des listes

Exemple :

Sub test_select_case()    Dim dictCas, liste(1 To 2)
    Dim i As Long, j As Long, k As Long, tmp

    liste(1) = Array("groupe1", "1 to 2", 4, "7 to 13")
    liste(2) = Array("groupe2", 3, 4, "5 to 7", "14 to 35")

    Set dictCas = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(liste)
        For i = 1 To UBound(liste(j))
            If IsNumeric(liste(j)(i)) Then
                If dictCas.exists(liste(j)(i)) Then MsgBox "Anomalie recouvrement sur index = " & liste(j)(i)
                dictCas(liste(j)(i)) = liste(j)(0)
            Else
                tmp = Split(liste(j)(i), " to ")
                For k = CLng(tmp(0)) To CLng(tmp(1))
                    If dictCas.exists(k) Then MsgBox "Anomalie recouvrement sur index = " & k
                    dictCas(k) = liste(j)(0)
                Next k
            End If
        Next i
    Next j




    For i = 1 To 7
        Select Case dictCas(i)
        Case "groupe1"
            Stop    'Call toto1
        Case "groupe2"
            Stop    'Call toto2
        End Select
    Next i
    Set dictCas = Nothing
End Sub

On aurait pu simplifier la saisie en choisissant la syntaxe 7.13 au lieu de "7 to 13"
Tant que j'y étais j'ai ajouté un contrôle de double déclaration. Ici 4 et "7" sont déclarés 2 fois