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
| Option Explicit
Dim LastLig As Long
Private Sub UserForm_Initialize()
Dim Ws As Worksheet
For Each Ws In Worksheets
If Len(Ws.Name) = 3 Then Me.LstMap.AddItem Ws.Name
Next Ws
With Me.LstFiltre
.ColumnCount = 2
.BoundColumn = 1
.ColumnWidths = "70;150"
End With
With Me.LstResult
.ColumnCount = 2
.BoundColumn = 1
.ColumnWidths = "70;150"
End With
End Sub
Private Sub LstMap_Change()
Me.TbCode.Value = ""
Me.TbLibel.Value = ""
Me.LstFiltre.Clear
If Me.LstMap.ListIndex > -1 Then
With Sheets(Me.LstMap.Value)
LastLig = .Cells(.Rows.Count, 4).End(xlUp).Row
End With
Call Remplir
End If
End Sub
Private Sub Remplir(Optional ByVal Str As String, Optional ByVal Code As Boolean)
Dim Dico As Object
Dim Ofs As Byte
Dim c As Range
Me.LstFiltre.Clear
Str = "*" & Replace(UCase(Str), " ", "*") & "*"
Ofs = Abs(Code)
Set Dico = CreateObject("Scripting.Dictionary")
For Each c In Worksheets(Me.LstMap.Value).Range("A3:A" & LastLig).Offset(0, Ofs)
If c.Value <> "" Then
If UCase(c.Value) Like Str Then
If Not Dico.exists(c.Value) Then
Dico.Add c.Value, c.Value
With Me.LstFiltre
.AddItem c.Offset(0, -Ofs).Value
.List(.ListCount - 1, 1) = c.Offset(0, 1 - Ofs).Value
End With
End If
End If
End If
Next c
Set Dico = Nothing
End Sub
Private Sub TbCode_Change()
Remplir Me.TbCode.Value
End Sub
Private Sub TbLibel_Change()
Remplir Me.TbLibel.Value, True
End Sub
Private Sub LstFiltre_Change()
Dim Code As String
Dim c As Range
Me.LstResult.Clear
If Me.LstFiltre.ListIndex > -1 Then
Code = Me.LstFiltre.Value
For Each c In Worksheets(Me.LstMap.Value).Range("A3:A" & LastLig)
If c.Value = Code Then
With Me.LstResult
.AddItem c.Offset(0, 2).Value
.List(.ListCount - 1, 1) = c.Offset(0, 3).Value
End With
End If
Next c
End If
End Sub
Private Sub BtnReset_Click()
Me.LstMap.ListIndex = -1
End Sub
Private Sub BtnExit_Click()
Unload Me
End Sub |
Partager