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
| Private Sub ComboBox1_Change()
Dim D As Object
Dim I As Integer
Dim J As Byte
Dim K As Integer
Dim TL() As Variant
Dim TMP As Variant
Dim NE As Integer
Dim R As Range
Dim DT As Date
Me.ListBox1.Clear
TV = OA.Range("A1").CurrentRegion
Set D = CreateObject("Scripting.Dictionary")
For I = 2 To UBound(TV, 1)
D(TV(I, 2)) = ""
Next I
TMP = D.keys
For NE = 0 To UBound(TMP)
Set R = OA.Columns(2).Find(TMP(NE), OA.Range("B1"), xlValues, xlWhole)
DT = DateSerial(Year(R.Offset(0, -1).Value), Month(R.Offset(0, -1).Value), Day(R.Offset(0, -1).Value))
For I = 2 To UBound(TV, 1)
If TMP(NE) = TV(I, 2) Then
If Application.WorksheetFunction.CountIf(OA.Columns(2), TMP(NE)) = 1 Then
If TV(I, 4) = Me.ComboBox1.Value Then
K = K + 1
ReDim Preserve TL(1 To 6, 1 To K)
For J = 2 To UBound(TV, 2)
TL(J - 1, K) = TV(I, J)
Next J
End If
End If
If TV(I, 4) = Me.ComboBox1.Value And DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day(TV(I, 1))) > DT Then
K = K + 1
ReDim Preserve TL(1 To 6, 1 To K)
For J = 2 To UBound(TV, 2)
TL(J - 1, K) = TV(I, J)
Next J
End If
End If
Next I
Next NE
If K > 0 Then
Me.ListBox1.Column = TL
End If
Tri_ListBox
End Sub |
Partager