Bonjour
je souhaiterais ameliorer le code ci apres.

1er -
Quand j'ouvre l'userform et que je clique un item dans la listbox1, la donnee s'incrit sur la feuil1 en B..
je souhaiterais que la cellule avant et les 5 cellules suivantes est la couleur bleu

2eme -
Quand j'ouvre l'userform et que je clique un item dans la listbox3, la donnee s'incrit sur la feuil1 en B..
je souhaiterais mettre une formule en F. (somme de D..+ E..)

et dans la cellule F la formule recherchev (la valeur en B..) dans la table matrice nommee tableau
avoir n° index.col (4).

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = c.Value
  Next c
  Me.ListBox1.List = mondico.items
  Me.ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBox1_Change()
    Me.ListBox3.Clear
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range(f.[A2], f.[C65000].End(xlUp))
        For k = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(k) = True Then
            If c = Me.ListBox1.List(k, 0) Then
              temp = c.Offset(, 1)
              mondico(temp) = temp
            End If
          End If
        Next k
    Next c
    Me.ListBox2.List = mondico.items
End Sub
Private Sub ListBox2_Change()
  Me.ListBox3.Clear
  For Each c In Range(f.[B2], f.[B65000].End(xlUp))
    For k = 0 To Me.ListBox2.ListCount - 1
      If Me.ListBox2.Selected(k) = True Then
        If c = Me.ListBox2.List(k, 0) Then Me.ListBox3.AddItem c.Offset(, 1)
      End If
     Next k
  Next c
End Sub
Private Sub CommandButton1_Click()
'Sheets("feuil3").Activate
Dim I As Integer, y As Integer
    Set sh = Sheets("Feuil1")
    y = sh.[B:B].Find("*", , , , xlByRows, xlPrevious).Row
    With Me.ListBox1
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            y = y + 1
            sh.Range("B" & y).Value = .List(I)
            With sh.Range("B" & y).Font
                .Name = "Calibri"
                .Size = 9
                .Bold = True
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0
 
    End With
    End If
    Next I
    End With
 
    With Me.ListBox2
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        sh.Range("B" & y).Value = .List(I)
        With sh.Range("B" & y).Font
            .Name = "Calibri"
            .Size = 9
            .Bold = True
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0
        End With
        End If
        Next I
    End With
 
    With Me.ListBox3
        For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
        y = y + 1
        sh.Range("B" & y).Value = .List(I)
        With sh.Range("B" & y).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 9
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
        End With
        End If
    Next I
     'ActiveCell.FormulaRC = "=VLOOKUP(Feuil1!RC[-5],BD!R[-10]C[-6]:R[97]C[-3],4)"
    End With
 
 
    For I = 0 To Me.ListBox1.ListCount - 1
    Me.ListBox1.Selected(I) = False
    Next I
    For I = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox2.RemoveItem 0
    Next I
    For I = 0 To Me.ListBox3.ListCount - 1
        Me.ListBox3.RemoveItem 0
    Next I
    Me.ListBox1.SetFocus
    'Dico.RemoveAll
End Sub