XL 2010 VBA - Variables avec plusieurs valeurs

[Nairolf87]

Bonjour,
Je cherche à ce que pour une variable donnée puisse me restituer plusieurs valeurs.
Imaginons une liste de cette manière :

Bordeaux -- Vin
Marseille -- Pastis
Nîmes -- Arène
Annecy -- Lac
Genève -- Chocolat
Strasbourg -- Choucroute
Bordeaux -- Rouge
Marseille -- Navettes

Si ma variable doit aller chercher Bordeaux, elle me ramène Vin Rouge,
Si ma variable doit aller chercher Marseille, elle me ramène Pastis Navettes.

Mais il faut qu'après je puisse utiliser ses variables dans le code pour ouvrir un onglet.

J'ai pensé à déclarer la variable en variant et ensuite utiliser Array ca ne fonctionne pas.

Sub marica()

Dim feuille() As Variant
Dim derlig, i As Integer
Dim cptr As Byte



'On affiche tous les onglets
For cptr = 1 To ThisWorkbook.Sheets.Count
Sheets(cptr).Visible = True
Next
   
Application.ScreenUpdating = False
matricule = "Bordeaux"
 
Sheets("Table").Select
derlig = Range("A" & Cells.Rows.Count).End(xlUp).Row

For i = 1 To derlig
    If Cells(i, 1).Value = matricule Then
    Array(feuille) = Cells(i, 2).Value
    End If
Next
   


'On affiche que les onglets contenus dans la variable
For cptr = 1 To ThisWorkbook.Sheets.Count
     If Sheets(cptr).Name <> feuille Then
     Sheets(cptr).Visible = 2
     End If
Next


End Sub

 

[Paf]

Bonjour

une solution possible avec tableau:

Sub marica()
Dim derlig, i As Integer
Dim cptr As Byte
Dim Tablo()
Application.ScreenUpdating = False
matricule = "Bordeaux"
' on crée un tableau des  correspondant à matricule
With Sheets("Table")
derlig = .Range("A" & Cells.Rows.Count).End(xlUp).Row
For i = 1 To derlig
    If .Cells(i, 1).Value = matricule Then
        x = x + 1
        ReDim Preserve Tablo(1 To x)
        Tablo(x) = .Cells(i, 2).Value
    End If
Next
End With
' on masque toutes les feuille du tableau puis ou démasque les bonnes feuilles
For cptr = 1 To ThisWorkbook.Sheets.Count
    If Sheets(cptr).Name <> "Table" Then Sheets(cptr).Visible = False
Next
For cptr = LBound(Tablo) To UBound(Tablo) 'du 1er au dernier élément du tablo
     Sheets(Tablo(cptr)).Visible = True
Next
Application.ScreenUpdating = True
End Sub

attention :
- les feuilles à masquer doivent exister ( exemple Choucroute) ou bien faire un test d'existence avant masquage.
- à l'écriture des noms de feuille par rapport à la colonne B ( Navette et Navettes)
- à l'écriture des noms de villes ("Bordeaux" et "Bordeaux " un espace en plus)

A+

 

[pierrejean]

Bonjour Nairolf

Un essai

Edit : Salut Paf

 

[Nairolf87]

Bonjour

une solution possible avec tableau:

Sub marica()
Dim derlig, i As Integer
Dim cptr As Byte
Dim Tablo()
Application.ScreenUpdating = False
matricule = "Bordeaux"
' on crée un tableau des  correspondant à matricule
With Sheets("Table")
derlig = .Range("A" & Cells.Rows.Count).End(xlUp).Row
For i = 1 To derlig
    If .Cells(i, 1).Value = matricule Then
        x = x + 1
        ReDim Preserve Tablo(1 To x)
        Tablo(x) = .Cells(i, 2).Value
    End If
Next
End With
' on masque toutes les feuille du tableau puis ou démasque les bonnes feuilles
For cptr = 1 To ThisWorkbook.Sheets.Count
    If Sheets(cptr).Name <> "Table" Then Sheets(cptr).Visible = False
Next
For cptr = LBound(Tablo) To UBound(Tablo) 'du 1er au dernier élément du tablo
     Sheets(Tablo(cptr)).Visible = True
Next
Application.ScreenUpdating = True
End Sub

attention :
- les feuilles à masquer doivent exister ( exemple Choucroute) ou bien faire un test d'existence avant masquage.
- à l'écriture des noms de feuille par rapport à la colonne B ( Navette et Navettes)
- à l'écriture des noms de villes ("Bordeaux" et "Bordeaux " un espace en plus)

A+

Merci beaucoup pour ta solution mais cela ne me mets pas 2 onglets qd il y a 2 villes par exemple alors que dans la solution de Pierre-Jean ca marche mieux. Je connais bien VBA, mais je ne comprends pas ce que vous avez fait ! mais ca marche !
merci!

 

[Paf]

re et bonjour pierrejean,

Merci beaucoup pour ta solution mais cela ne me mets pas 2 onglets qd il y a 2 villes par exemple

si l'illustration de ce propos est Bordeaux (seule ville en plusieurs exemplaire dans la liste) mon code laisse les feuilles vin et rouge non masquée.
s'il s'agit de sélectionner 2 villes avant la macro, effectivement les codes proposés ne sont pas fait pour !

par ailleurs, il y a une correction à apporter :For cptr =2 To ThisWorkbook.Sheets.Count

A+

 

[laetitia90]

bonjour Nairolf , Paf,pierre jean
si pas trop de lignes on pourrait simplifier??

Sub es()
  Dim t(), i As Long
  On Error Resume Next
  Application.ScreenUpdating = 0
  t = Range("a1:b" & Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  Sheets(t(i, 2)).Visible = IIf(t(i, 1) = ActiveCell, 1, 0)
  Next i
End Sub