BBS - Powered by Discuz! Board

标题: 应ghunter帖子，发修改的test文档 [打印本页]

作者: zhendeaini 时间: 2014-10-22 13:15 标题: 应ghunter帖子，发修改的test文档

原帖由 ghunter 于 2014-10-21 09:50 发表

此表有两个表，1。输出表（所有的资料都在输出表中体现）；2。数据表（原始数据）
要求：
1.从输出表的第二行开始输出所需要的数据。
2.输出表的右边黄色标记的地方为下拉列表框，此处可对数据表中的数据进行筛选，点击后会对数据表进行筛选，结果在输出表的第二行开始实时输出。
3.下拉列表框中的数据，从数据表中实时生成，如：数据表中，性别如果只有男性，则输出表的对应下拉列表中的选项只有男性，例表中，输出表班级的下拉列表框中的数据应为：101，102，103，104，201，305.
4.按要求输出指定的数据，如果没有指定，则输出全部数据。

原帖地址：http://150.48.48.12/BBS/viewthread.php?tid=16072&extra=page%3D1

思路：
1、获取多选项下拉列表的选项，方法：先在sheet2中设置辅助列，利用高级筛选功能，录制宏（工具→宏→录制新宏），得到唯一值（各列不重复值）。然后利用Worksheet_Change事件，实时更新下拉选项。
2、利用数据有效性得到多选项下拉列表的选项。
3、编写好代码，点击“CommandButton1”命令按钮，得到值。

——by zhendeaini 22,Oct.,2014

[ 本帖最后由 zhendeaini 于 2014-10-22 13:51 编辑 ]

附件: test.xls (2014-10-22 13:46, 80 KB) / 该附件被下载次数 94
http://hahabbs.w1.luyouxia.net/bbs/attachment.php?aid=116104

作者: ghunter 时间: 2014-10-22 13:18

引用:

原帖由 zhendeaini 于 2014-10-22 13:15 发表
原帖由 ghunter 于 2014-10-21 09:50 发表
此表有两个表，1。输出表（所有的资料都在输出表中体现）；2。数据表（原始数据）
要求：
1.从输出表的第二行开始输出 ...

不错，做得很好~
相当厉害啊~~神一般的存在~

作者: zhendeaini 时间: 2014-10-22 14:15

引用:

原帖由 ghunter 于 2014-10-22 13:18 发表

不错，做得很好~
相当厉害啊~~神一般的存在~

不敢，很多不懂的啊！像此案例中涉及到SQL查询语句。

作者: ghunter 时间: 2014-10-22 15:39

能详细地写一篇教学文，手把手教一教我做法，好吗？

作者: zhendeaini 时间: 2014-10-22 17:11

引用:

原帖由 ghunter 于 2014-10-22 15:39 发表
能详细地写一篇教学文，手把手教一教我做法，好吗？

这个比较多哦，最近工作也比较忙。我公开代码吧：
第一步是录制宏，目的是得到唯一值（各列不重复值）

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

作者: zhendeaini 时间: 2014-10-22 17:15

引用:

原帖由 ghunter 于 2014-10-22 15:39 发表
能详细地写一篇教学文，手把手教一教我做法，好吗？

第二步，设置下拉列表

由于引用了sheet2数据，所以先Ctrl+F3，定义名称，以便设置数据有效性时候引用。

比如说：设置名姓名=OFFSET(数据表!$K$2,,,COUNTA(数据表!$K:$K))
以此类推设置好

点击“数据”→ “有效性”→有效性条件选择“序列”输入=名称
以此类推设置好

作者: zhendeaini 时间: 2014-10-22 17:25

引用:

原帖由 ghunter 于 2014-10-22 15:39 发表
能详细地写一篇教学文，手把手教一教我做法，好吗？

第三步：书写代码
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

至此，程序完毕！到目前为止，没有发现错误。

作者: ghunter 时间: 2014-10-22 17:27

牛人啊~~

作者: seaxin 时间: 2014-10-22 17:35

学习下，虽然还用不上～[39]

作者: maximus 时间: 2014-10-23 08:54

牛。太有心了。

作者: ghunter 时间: 2014-10-23 08:58

有没有关于EXCEL宏的这方面的书推荐几本？！谢谢

作者: ghunter 时间: 2014-10-23 09:05

这是一篇好文，建议长期置顶~

作者: zhendeaini 时间: 2014-10-23 10:26

引用:

原帖由 ghunter 于 2014-10-23 08:58 发表
有没有关于EXCEL宏的这方面的书推荐几本？！谢谢

这个有很多的，要注意的是Excel 2003和比Excel 2003更高级版本的编程代码是有些许不同，因为控件名称不同了。（Office 2003基于Visual Basic 6.0而成的编程环境，目前Visual Basic 6.0已经逐步退出历史舞台，Visual Basic.NET登台出场），在2003环境下完美运行的，在其他版本不一定能够完美运行。

作者: ghunter 时间: 2014-10-23 11:01

引用:

原帖由 zhendeaini 于 2014-10-23 10:26 发表

这个有很多的，要注意的是Excel 2003和比Excel 2003更高级版本的编程代码是有些许不同，因为控件名称不同了。（Office 2003基于Visual Basic 6.0而成的编程环境，目前Visual Basic 6.0已经逐步退出历史舞台，Vis ...

的确如此，我在2003下用数据库链接的方式导入外部数据，用SQL做查询，在2013下用不了。。。也同样能做出类似的效果，但明显没有你的方法简便易懂
我的办法就是每次都更新导入外部数据，而所谓的外部数据就是表2.

作者: zhendeaini 时间: 2014-10-23 17:15

引用:

原帖由 ghunter 于 2014-10-23 11:01 发表

的确如此，我在2003下用数据库链接的方式导入外部数据，用SQL做查询，在2013下用不了。。。也同样能做出类似的效果，但明显没有你的方法简便易懂
我的办法就是每次都更新导入外部数据，而所谓的外部数据就是表2 ...

其实，这里采用了辅助列这一概念，目的是能实时更新下拉选项！有时候采用直接的方法不行，那就换位思考下，能否婉转表达。[39]

作者: ghunter 时间: 2014-10-24 08:50

引用:

原帖由 zhendeaini 于 2014-10-23 17:15 发表

其实，这里采用了辅助列这一概念，目的是能实时更新下拉选项！有时候采用直接的方法不行，那就换位思考下，能否婉转表达。[39]

我也做了辅助列，辅助列A由导入外部数据生成，每次更新数据表时会自动更新，使用列表框列出筛选出来的值，选定值再返回到辅助列B中。

作者: zhendeaini 时间: 2014-10-31 17:13

引用:

原帖由 ghunter 于 2014-10-24 08:50 发表

我也做了辅助列，辅助列A由导入外部数据生成，每次更新数据表时会自动更新，使用列表框列出筛选出来的值，选定值再返回到辅助列B中。

[12]

欢迎光临 BBS (http://hahabbs.w1.luyouxia.net/bbs/)