数据有“序号”，“姓名”，“数据”，“更新日期”四列，EXCEL表名为“原始数据表”。在另一张表名为“提取数据表”的工作表中“F1”单元格中预先输入一个截止日期，如“2010-10-5”，要求提取“原始数据表”中各姓名项的“更新日期”项中日期小于“2010-10-5”而又最接近的数据，把提到的数据一行行地输出到“提取数据表”表中（第一行为列标题，从第二行放起）如下表：
序号 姓名 数据 更新日期
1 张三 24 2010-4-7
2 李四 39 2010-4-7
3 王五 24 2010-4-7
4 李四 59 2010-5-9
5 张三 77 2010-7-4
6 王五 60 2010-8-6
7 马二 34 2010-9-7
8 王五 89 2010-9-15
9 张三 67 2010-9-25
10 张三 46 2010-9-25
11 李四 82 2010-9-25
12 王五 19 2010-9-30
13 马二 60 2010-9-30
14 马二 45 2010-10-3
15 王五 25 2010-10-5
16 赵六 65 2010-10-20
17 李四 34 2010-11-4
18 马二 28 2010-11-4
19 王五 64 2010-11-15
20 赵六 65 2010-11-15
提出的数据如下：
序号 姓名 数据 更新日期
10 张三 46 2010-9-25
11 李四 82 2010-9-25
14 马二 45 2010-10-3
15 王五 25 2010-10-5
要求说明：
1、每个姓名项只提一条数据。
2、在截止日期前未出现的名字不提取。如“赵六”不提取。
3、同一姓名，日期相同的有两条以上的取最后一条。如“张三”的数据取第10条而不取第9条。
4、我的实际数据有5000多条，涉及的姓名有几百个。截止的日期也是可以变化的。
好的代码另加30分
fengzhikuye ：我想问，小于“2010-10-5”而又最接近的数据，是什么意思？
比如2010-10-5比2010-10-4更接近2010-10-5，就是说2010-10-5也包括在内。要取更新日期小于（或等于）截止日期的最接近截止日期的数据。问题是否清楚了？
您的代码运行很快，谢谢。但当F1输入日期小于更新日期最小值时会报错-“下标越界”；还有能帮我解释下字典的用法吗，d.Add arr(x, 2), ""中的""是什么意义呀?
追答输入日期小于更新日期最小值，也就是说没有数据，出现的错误是吧？给你加个提示，当F1输入的日期小于最小更新日期时，会弹出“您查找的数据不存在！”的提示。
因此时字典只是用于查找唯一值，对应的会有很多个日期，我们只是要小于等于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) 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
这下可以了吧。
经过多次测试发现，还有一个问题，就是这个代码对原始数据中“更新日期”列数据的排列顺序要求严格，必须是升序，否则就会出错，得不到正确的结果。虽然在正常情况下，我的数据这一列是升序的，但为了程序的通用性考虑，请问能否修改代码，使得在这一列不是升序的时候也能用——当然，是在不预先对原始数据进行排序的情况下。对您的热心帮助再次表示感谢！
追答你这是记录用的，更新日期一列，必然是升序。还需要排序吗？
更新日期乱序，可用如下代码
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 = 1 To UBound(arr)
If Not d.exists(arr(x, 2)) And arr(x, 4) arr1(4, i) And arr(j, 4) 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