关于ghunter帖子test程序的代码简要说明
第一步是录制宏，目的是得到唯一值（各列不重复值）
Option Explicit
Sub 高级筛选—姓名()
'
' 高级筛选—姓名 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Sheet2.Select
Columns("A:A").Select
Sheet2.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"K:K"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—班级()
'
' 高级筛选—班级 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("B:B").Select
Sheet2.Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"L:L"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—学号()
'
' 高级筛选—学号 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("C:C").Select
Sheet2.Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"M:M"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—入学年月()
'
' 高级筛选—入学年月 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("D:D").Select
Sheet2.Columns("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"N:N"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—性别()
'
' 高级筛选—喜好 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("E:E").Select
Sheet2.Columns("E:E").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"O:O"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—喜好()
'
' 高级筛选—喜好 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("F:F").Select
Sheet2.Columns("F:F").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"P:P"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—数据1()
'
' 高级筛选—数据1 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("G:G").Select
Sheet2.Columns("G:G").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"Q:Q"), Unique:=True
End Sub
Option Explicit
Sub 高级筛选—数据2()
'
' 高级筛选—数据2 Macro
' 宏由 zhendeaini 录制，时间: 2014-10-21
'
'
Columns("H:H").Select
Sheet2.Columns("H:H").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"R:R"), Unique:=True
Range("A1").Select
End Sub
第二步，设置下拉列表
由于引用了sheet2数据，所以先Ctrl+F3，定义名称，以便设置数据有效性时候引用。
比如说：设置名姓名=OFFSET(数据表!$K$2,,,COUNTA(数据表!$K:$K))
以此类推设置好
点击“数据”→ “有效性”→有效性条件选择“序列”输入=名称
以此类推设置好
第三步：书写代码
Alt+F11打开VB编辑器或者“工具”→“宏”→Visual Basic编辑器
1、先在左边的ThisWorkBook输入Workbook_Open触发事件
Private Sub Workbook_Open()
Sheet1.Activate
Dim sht As Worksheet
Set sht = ActiveSheet
Application.ScreenUpdating = False
Call 高级筛选—姓名
Call 高级筛选—班级
Call 高级筛选—学号
Call 高级筛选—入学年月
Call 高级筛选—性别
Call 高级筛选—喜好
Call 高级筛选—数据1
Call 高级筛选—数据2
sht.Select
Sheet1.[K1] = ""
Sheet1.[L1] = ""
Sheet1.[M1] = ""
Sheet1.[N1] = ""
Sheet1.[O1] = ""
Sheet1.[P1] = ""
Sheet1.[Q1] = ""
Sheet1.[R1] = ""
Application.ScreenUpdating = True
End Sub
意思是当你打开Excel的时候自动运行宏代码
2、在sheet2工作表（数据表）中输入Worksheet_Change触发事件，目的是当你在sheet2工作表更改数据的时候自动更新宏代码。简单地说做到实时更新。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ChgArea As Range
Dim ChgCell As Range
Dim ChgAdd As String
Set ChgArea = Range("A2:H10000")
For Each ChgCell In ChgArea
ChgAdd = ChgCell.Address
If Target.Address = ChgAdd Then
'MsgBox "注意：内容有变化，请确认！", vbExclamation
Dim sht As Worksheet
Set sht = ActiveSheet
Application.ScreenUpdating = False
Call 高级筛选—姓名
Call 高级筛选—班级
Call 高级筛选—学号
Call 高级筛选—入学年月
Call 高级筛选—性别
Call 高级筛选—喜好
Call 高级筛选—数据1
Call 高级筛选—数据2
Application.ScreenUpdating = True
End If
Next
End Sub
3、在sheet1工作表（输出表）书写CommandButton1命令按钮代码，这是实现你所需的功能的关键代码。
Option Explicit
Private Sub CommandButton1_Click()
'Dim CNN As New ADODB.Connection
'Dim RST As New ADODB.Recordset
Dim CNN, strsql$, aa, HH, BB, CC, DD, JJ, KK
Set CNN = CreateObject("adodb.connection")
'Dim strsql$
Dim i&, t&
Application.ScreenUpdating = False
t = Sheet1.Range("A65536").End(xlUp).Row
CNN.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
If Sheet1.[K3] <> "" Then
aa = " and 班级 like '%" & Sheet1.[K3] & "%'"
End If
If Sheet1.[K4] <> "" Then
HH = " AND 学号 like '%" & Sheet1.[K4] & "%'"
End If
If Sheet1.[K5] <> "" Then
BB = " AND 入学年月 like '%" & Sheet1.[K5] & "%'"
End If
If Sheet1.[K6] <> "" Then
CC = " AND 性别 like '%" & Sheet1.[K6] & "%'"
End If
If Sheet1.[K7] <> "" Then
DD = " AND 喜好 like '%" & Sheet1.[K7] & "%'"
End If
JJ = aa & BB & HH & CC & DD
If Len(JJ) Then KK = "WHERE " & Mid(JJ, 6, 888)
strsql = "select 姓名,班级,学号,入学年月,性别,喜好,数据1,数据2 FROM [数据表$A:H] " & KK
Sheet1.Range("A2").CurrentRegion.ClearContents
Sheet1.Range("A1:H1") = Sheet2.Range("A1:H1").Value
Sheet1.[A2].CopyFromRecordset CNN.Execute(strsql)
CNN.Close
Set CNN = Nothing
Application.ScreenUpdating = True
End Sub
至此，程序完毕！到目前为止，没有发现错误。
