給妳來個字典和動態數組，單元格事件的，就是在F1輸入完截止日期，回車自動運行的
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x&, i&
Dim t1 As Date
Dim arr, arr1()
Dim d
Set d = CreateObject("scripting.dictionary")
If Target.Address = "$F$1" Then
t1 = Target.Value
With Sheets("原始數據表")
arr = .Range("A2:D" & .Range("A65536").End(xlUp).Row).Value
End With
For x = UBound(arr) To 1 Step -1
If Not d.exists(arr(x, 2)) And arr(x, 4) <= t1 Then
i = i + 1
d.Add arr(x, 2), ""
ReDim Preserve arr1(1 To 4, 0 To i)
For k = 1 To 4
arr1(k, i) = arr(x, k)
Next k
End If
Next x
For i = 1 To UBound(arr1, 2) - 1
For j = i + 1 To UBound(arr1, 2)
If arr1(1, i) > arr1(1, j) Then
For l = 1 To 4
t = arr1(l, i)
arr1(l, i) = arr1(l, j)
arr1(l, j) = t
Next l
End If
Next j
Next i
arr1(1, 0) = "序號"
arr1(2, 0) = "姓名"
arr1(3, 0) = "數據"
arr1(4, 0) = "更新日期"
Range("A:D").ClearContents
Range("A1").Resize(UBound(arr1, 2) + 1, 4) = Application.Transpose(arr1)
End If
End Sub
速度很快了。