Option Compare Text
Dim f
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Me.Source.List = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value
Me.Dest.List = f.Range("B2:B" & f.[B65000].End(xlUp).Row).Value
ListeManque
ListeSeries
End Sub
Private Sub b_prend_Click()
If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
Item = Me.Source '.List(i)
If Me.Dest.ListCount > 0 Then
Tbl = Me.Dest.List
p = Application.Match(Item, Application.Index(Tbl, 0), 0)
If IsError(p) Then Me.Dest.AddItem Item
Else
Me.Dest.AddItem Item
End If
End If
ListeManque
End Sub
Private Sub B_enlève_Click()
If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then Me.Dest.RemoveItem Me.Dest.ListIndex
ListeManque
End Sub
Sub ListeManque()
Set d = CreateObject("scripting.dictionary")
For i = 0 To Dest.ListCount - 1
d(Me.Dest.List(i)) = ""
Next i
Set d2 = CreateObject("scripting.dictionary")
For i = 0 To Source.ListCount - 1
tmp = Me.Source.List(i, 0)
If Not d.exists(tmp) Then d2(tmp) = ""
Next i
Me.ListBox1.List = d2.keys
End Sub
Private Sub B_transfert_bd_Click()
Tbl = f.Range("B2:B" & f.[B65000].End(xlUp).Row).Value
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(Tbl)
tmp = Tbl(i, 1)
d(tmp) = ""
Next i
'-- sup série
For i = 1 To UBound(Tbl)
tmp = Tbl(i, 1)
If tmp Like Me.ComboBox1 & "*" Then d.Remove (tmp)
Next i
'-- nv série
Tbl1 = Me.Dest.List
For i = 0 To Me.Dest.ListCount - 1
tmp = Tbl1(i, 0)
d(tmp) = ""
Next i
f.[B2:B1000].ClearContents
f.[B2].Resize(d.Count) = Application.Transpose(d.keys)
f.[B2].Resize(d.Count).Sort key1:=[B2], Header:=no
End Sub
Sub ListeSeries()
Set d = CreateObject("scripting.dictionary")
d("*") = ""
Tbl = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value
For i = 1 To UBound(Tbl)
p = InStr(Tbl(i, 1), "Saison")
If p > 0 Then
tmp = Trim(Left(Tbl(i, 1), p - 1))
d(tmp) = ""
End If
Next i
Me.ComboBox1 = "*"
Me.ComboBox1.List = d.keys
End Sub
Private Sub ComboBox1_Click()
Tbl1 = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value
Tbl3 = f.Range("B2:B" & f.[B65000].End(xlUp).Row).Value
Dim Tbl2()
choix = Me.ComboBox1 & "*"
n = 0
For i = 1 To UBound(Tbl1)
If Tbl1(i, 1) Like choix Then
n = n + 1: ReDim Preserve Tbl2(1 To n)
Tbl2(n) = Tbl1(i, 1)
End If
Next i
Me.Source.List = Tbl2
'--
Dim Tbl4()
n = 0
For i = 1 To UBound(Tbl3)
If Tbl3(i, 1) Like choix Then
n = n + 1: ReDim Preserve Tbl4(1 To n)
Tbl4(n) = Tbl3(i, 1)
End If
Next i
If n > 0 Then Me.Dest.List = Tbl4 Else Me.Dest.Clear
ListeManque
End Sub
Private Sub B_ajout_Click()
If Me.TextBox1 <> "" Then
If InStr(Me.TextBox1, "saison") = 0 Then
MsgBox "Manque saison!"
Me.TextBox1.SetFocus
Exit Sub
End If
n = f.[A65000].End(xlUp).Row
Cells(n + 1, "a") = Me.TextBox1
Me.TextBox1 = ""
f.[A2].Resize(n + 1).Sort key1:=[A2], Header:=no
UserForm_Initialize
End If
End Sub
Private Sub B_sup_Click()
If Me.Source.ListCount > 0 And Me.Source.ListIndex <> -1 Then
tmp = Me.Source
Set p = f.[A:A].Find(tmp)
If Not p Is Nothing Then
If MsgBox("Etes vous sûr de supprimer " & tmp & "?", vbYesNo) = vbYes Then
f.Cells(p.Row, "a").Delete Shift:=xlUp
UserForm_Initialize
End If
End If
End If
ListeManque
End Sub