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
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
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
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é ??
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
Ah ok.
Et bien tu peux l'écrire sous cette forme :
Code:
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
j'ai peut-être mal compris, alors, d'avance toutes mes excuses.
Avec cette macro
Code:
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
Merci,
C'est c'que je cherchais !
Pour info,
lorsque tu écris :
Code:
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 ?
Code:
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 ?
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 ?
Code:
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
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