Option Explicit
Dim s As Long, z As String, Nb As Long, m As Object
Dim t, x As Variant, i As Long, k As Long
Private Sub c1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0 'prefere a 2 - DropDown List dans proprietees
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Range("A2:y" & Cells(Rows.Count, "a").End(xlUp).Row).Cut Destination:=Range("A1")
Application.DisplayAlerts = False
Sheets("TEMP").Delete
Application.DisplayAlerts = True
Sheets("Menu").Activate
Unload Me
End Sub
Private Sub UserForm_Initialize()
Label4.Visible = True
Repaint
On Error Resume Next
Application.ScreenUpdating = False
s = Timer
Sheets("Données").Activate
Set m = CreateObject("Scripting.Dictionary")
x = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each t In x
m(t) = t
Next t
[z1].Resize(m.Count, 1) = Application.Transpose(m.keys)
Set m = Nothing
x = Range("z1", Cells(Rows.Count, "z").End(xlUp))
For i = 1 To UBound(x, 1)
For k = 1 To UBound(x, 2)
x(i, k) = Right(x(i, k), 4)
Next k: Next i
Range("z1", Cells(Rows.Count, "z").End(xlUp)) = x
Set m = CreateObject("Scripting.Dictionary")
x = Range("z1:z" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each t In x
m(t) = t
Next t
c1.List = m.Items
Set m = Nothing
Columns("Z:Z").ClearContents
Label4.Visible = False
Label2.Caption = format((Timer - s), "0.0" & " secondes")
ListBox1.ColumnWidths = "80 pt;50 pt;90 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
z = ActiveSheet.Name
Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Private Sub c1_Change()
On Error Resume Next
If c1 = "" Then Exit Sub
Label4.Visible = True
Repaint
Application.ScreenUpdating = False
s = Timer
Application.DisplayAlerts = False
Sheets("TEMP").Delete
Application.DisplayAlerts = True
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "TEMP"
With Sheets("TEMP")
.Cells(1, 1) = "liste 1": .Cells(1, 2) = "liste 2": .Cells(1, 3) = "liste 3": .Cells(1, 4) = "liste 4"
.Cells(1, 5) = "liste 5": .Cells(1, 6) = "liste 6": .Cells(1, 7) = "liste 7": .Cells(1, 8) = "liste 8"
.Cells(1, 9) = "liste 9": .Cells(1, 10) = "liste 10": .Cells(1, 11) = "liste 11": .Cells(1, 12) = "liste 12"
.Cells(1, 13) = "liste 13": .Cells(1, 14) = "liste 14": .Cells(1, 15) = "liste 15": .Cells(1, 16) = "liste 16"
.Cells(1, 17) = "liste 17": .Cells(1, 18) = "liste 18": .Cells(1, 19) = "liste 19": .Cells(1, 20) = "liste 20"
.Cells(1, 21) = "liste 21": .Cells(1, 22) = "liste 22": .Cells(1, 23) = "liste 23": .Cells(1, 24) = "liste 24"
.Cells(1, 25) = "liste 25"
End With
ListBox1.Clear
With Sheets("Données")
.AutoFilterMode = False
.[A1].AutoFilter Field:=1, Criteria1:="=*" & c1.Value & "*"
If Right(.Cells(2, 1), 4) = c1.Value Then
.Range("A2:y" & .Cells(Rows.Count, "a").End(xlUp).Row).SpecialCells(xlVisible).Copy _
Destination:=Sheets("TEMP").Range("A65536").End(xlUp)(2)
Else
.Range("A3:y" & .Cells(Rows.Count, "a").End(xlUp).Row).SpecialCells(xlVisible).Copy _
Destination:=Sheets("TEMP").Range("A65536").End(xlUp)(2)
End If
Sheets("TEMP").Activate
Nb = WorksheetFunction.CountA(Columns("A:A"))
ListBox1.RowSource = Range(Cells(2, 1), Cells(Nb, 25)).Address
Sheets(z).Select
.AutoFilterMode = False
End With
Label2.Caption = "nb..." & Nb - 1 & " " & " temps... " & format((Timer - s), "0.0" & " secondes")
Label4.Visible = False
End Sub
Private Sub c1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
c1.SetFocus: c1.DropDown
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
CreateObject("Wscript.shell").Popup "UN BOUTON EST PREVU POUR CELA !!!", 1, "pour fermer!!", vbCritical
Cancel = True
End If
End Sub
