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 |
