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
|
Recherche multi-colonnes multi-mots
les mots peuvent être saisis dans un ordre quelconque
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set Rng = f.Range("A3:G" & f.[a65000].End(xlUp).Row)
Ncol = Rng.Columns.Count
'---- entêtes ListBox
x = 15
Y = Me.ListBox1.Top - 12
For I = 1 To Ncol
Set Lab = Me.Controls.Add("Forms.Label.1")
Lab.Caption = f.Cells(2, I)
Lab.Top = Y
Lab.Left = x + 2
x = x + f.Columns(I).Width * 0.8
temp = temp & f.Columns(I).Width * 0.8 & ";"
Next
Me.ListBox1.ColumnCount = Ncol
Me.ListBox1.ColumnWidths = temp
'-- entêtes TextBox
For I = 1 To Ncol
Set Lab = Me.Controls.Add("Forms.Label.1")
Lab.Caption = f.Cells(2, I)
Lab.Top = Me("textbox" & I + 1).Top - 17
Lab.Left = Me("textbox" & I + 1).Left
x = x + f.Columns(I).Width * 0.5
Next
'--
TblTmp = Rng.Value
For I = LBound(TblTmp) To UBound(TblTmp)
ReDim Preserve choix(1 To I)
For k = LBound(TblTmp) To UBound(TblTmp, 2)
choix(I) = choix(I) & TblTmp(I, k) & " * "
Next k
Next I
Me.ListBox1.List = Rng.Value
End Sub
Private Sub TextBox1_Change()
If Me.TextBox1 <> "" Then
mots = Split(Trim(Me.TextBox1), " ")
Tbl = choix
For I = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(I), True, vbTextCompare)
Next I
n = 0: Dim b()
For I = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(I), "*")
n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
For k = 1 To Ncol
b(k, I + 1) = a(k - 1)
Next k
Next I
If n > 0 Then
ReDim Preserve b(1 To Ncol, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Me.Label1.Caption = UBound(Tbl) + 1
Else
UserForm_Initialize
End If
End Sub
Private Sub ListBox1_Click()
For k = 0 To Ncol - 1
Me("TextBox" & k + 2) = Me.ListBox1.Column(k)
Next k
End Sub |
Partager