Discussion :

[hockey123]

Bonjour,
Contexte:
J'ai des chiffres de 1 à 42 dans le Range("B5:C25").
J'ai un Range("E5:E10") qui devrait être un tableau intitulé choix.
Problématique:
Il faut que lorsque l'usager click avec sa souris sur un chiffre dans le premier range, celui-ci se retrouve en ordre croissant dans le tableau choix.
L'usager doit pouvoir sélectionner jusqu'à 6 chiffres.

J'ai tenté des trucs avec Worksheet_SelectionChange, mais je n'arrive pas à rien de très concret..
Merci pour toute aide !!

[babaothe]

J'ai tenté des trucs avec Worksheet_SelectionChange, mais je n'arrive pas à rien de très concret..

Salut
Montre le code que tu as tenté
Il nous permettra entre autres de mieux comprendre ce que veut exactement dire :

J'ai un Range("E5:E10") qui devrait être un tableau intitulé choix.

[Pierre Fauconnier]

Bonjour

...
Il faut que lorsque l'usager click avec sa souris sur un chiffre dans le premier range, celui-ci se retrouve en ordre croissant dans le tableau choix.
...

Personnellement, je ne comprends pas le sens de cette phrase.

[EDIT] Heu, finalement, j'ai pigé... [/EDIT]

[melouille56]

Salut Hockey
Essaye ca:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L As Integer, Valeur As Integer, i As Integer, j As Integer
Dim Cible As Variant
Dim Selection() As Double
If Not Intersect(Target, Range("B5:C25")) Is Nothing Then
    x = 0
    For L = 5 To 10
        If Not Cells(L, 5) = "" Then
            ReDim Preserve Selection(x)
            Selection(x) = Cells(L, 5).Value
            x = x + 1
        End If
    Next L
    If UBound(Selection) = 5 Then
        MsgBox "6 codes ont déjà été selectionnés." & Chr(10) & Chr(10) & _
            "Vous ne pouvez plus rien sélectionner"
        Exit Sub
    End If
    ReDim Preserve Selection(x)
    Selection(x) = Target.Value
    Do
        Valeur = 0
        For i = UBound(Selection) To 1 Step -1
            If Selection(i) < Selection(i - 1) Then
                Cible = Selection(i)
                Selection(i) = Selection(i - 1)
                Selection(i - 1) = Cible
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
    For x = 0 To UBound(Selection)
        Cells(x + 5, 5) = Selection(x)
    Next x
End If
End Sub

et dis

[fring]

Bonjour à tous,

J'ajoute mon petit grain de sel

L'évènement click n'existe pas pour une feuille mais on peu jouer sur le double click
Procédure à placer dans le module de la feuille en question

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plg1 As Range, Plg2 As Range, Cl As Range, Verif As Boolean
 
Set Plg1 = Range("B5:C25") '<-- plage source
Set Plg2 = Range("E5:E10") '<-- plage de destination
 
'vérification que la cellule sélectionnée est bien dans la plage source
If Application.Intersect(Target, Plg1) Is Nothing Then
    MsgBox "Sélectionnez un chiffre de 1 à 42 dans la liste"
    Cancel = True
    Exit Sub
End If
 
'vérification que le chiffre n'a pas encore été choisi
If Target.Interior.ColorIndex = 3 Then
    MsgBox "Ce chiffre a déjà été sélectionné, veuillez en choisir un autre."
    Cancel = True
    Exit Sub
End If
 
'insertion du chiffre sélectionné dans la plage de destination
For Each Cl In Plg2
    If Cl = "" Then
        Cl = Target.Value
        Verif = True
        Exit For
    End If
Next
 
'vérification si déjà 6 chiffres choisis
If Verif = True Then
    Verif = False
Else
    MsgBox "Vous avez déjà choisi 6 chiffres"
    Cancel = True
    Exit Sub
End If
 
'tri de la plage de destination
Plg2.Sort Key1:=Range("E5"), Order1:=xlAscending
 
'coloriage dans la plage source du chiffre choisi
Target.Interior.ColorIndex = 3
Cancel = True
 
End Sub

Reste à gérer le reset des plages

[mercatog]

Et une proposition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Not Intersect(Target, Range("B5:C25")) Is Nothing Then
    If Target.Count = 1 Then
        If Application.CountBlank(Range("E5:E10")) > 0 Then
            If Application.CountIf(Range("E5:E10"), Target.Value) = 0 Then
                Application.ScreenUpdating = False
                Range("E10").Value = Target.Value
                Range("E5:E10").Sort key1:=Range("E5"), Order1:=xlAscending, Header:=xlNo
            End If
        End If
    End If
End If
End Sub

[Pierre Fauconnier]

Salut.

Pour éviter les différents tests, je propose ceci, partant du fait que si E10 est vide, c'est qu'on n'a pas tout rempli, sinon c'est qu'on a tout rempli

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range("B5:C25"), Target) Is Nothing Then
      If IsEmpty(Range("e10")) Then
        Range("e10") = Target.Value
        Range("e5:e10").Sort key1:=Range("e5"), order1:=xlAscending, Header:=xlNo
      Else
      MsgBox "Tout est rempli"
    End If
  End If
End Sub