Excel和VBA代码：筛选并自动另存为新工作簿
我的图书馆
Excel和VBA代码：筛选并自动另存为新工作簿
发表评论：
TA的最新馆藏[转]&[转]&[转]&[转]&[转]&[转]&查看: 8541|回复: 10
在VBA怎样用自动筛选并列三个条件来筛选相应的数据
阅读权限20
在线时间 小时
& & & & & & & &
本帖最后由 minren118 于
11:16 编辑
因自动筛选的自定义筛选只有两个条件如图：
QQ截图01.png (23.06 KB, 下载次数: 78)
10:58 上传
，用录制宏可得到如下的代码& & ActiveSheet.Range(&$C$1:$H$128&).AutoFilter Field:=1, Criteria1:=&&&今日&, _& && &&&Operator:=xlAnd, Criteria2:=&&&上周同期&
但现在需要同时3个条件，我尝试了
ActiveSheet.Range(&$C$1:$H$128&).AutoFilter Field:=1, Criteria1:=&&&今日&, _& && &&&Operator:=xlAnd, Criteria2:=&&&昨日&, _
& && &&&Operator:=xlAnd, Criteria3:=&&&上周同期&
这样操作，但最终运行时显示错误。
QQ截图20.png (13.89 KB, 下载次数: 76)
11:04 上传
实际的需求是这样的，因为从网页上全选复制一个文档下来，很多信息不需要，只保留这个颜色的有用信息，现在想用自动筛选把除去第3列的值非”前7日、昨日、上周同期“这部分筛选出来，然后把它们删除掉，如果其他人有更好的思路也烦请提供一下，万分感谢。我自己想到另一种原始方法用for循环判断第3列的值是否等于”前7日、昨日、上周同期“中的一个，不等于，删除对应单元格的整列，但这种方法应该效率很低。
(19.7 KB, 下载次数: 69)
11:09 上传
点击文件名下载附件
阅读权限30
在线时间 小时
为何不用高级筛选呢.....
阅读权限30
在线时间 小时
这个是高级帅选录制的代码
Sub Macro1()
' Macro1 Macro
& & Range(&B9&).Select
& & Range(&A1:H77&).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
& && &&&&K4:M5&), CopyToRange:=Range(&A90:H90&), Unique:=False
& & ActiveWindow.SmallScroll Down:=90
阅读权限95
在线时间 小时
既然用VBA，就可以脱离既定工具
用数组，条件再多也不怕
虽然整体效果没有想象好
阅读权限20
在线时间 小时
sheet1 发表于
这个是高级帅选录制的代码
Sub Macro1()
刚刚我也想到用高级筛选了，谢谢分享
阅读权限20
在线时间 小时
李甲 发表于
既然用VBA，就可以脱离既定工具
用数组，条件再多也不怕
虽然整体效果没有想象好
能够写个代码来参考参考不？启发一下思路，因为听前辈说，EXCEL自有的功能效率高，所以喜欢在自有的功能上想，而且我新手一个，写数组、字典什么之类的对我难度太大，呵呵
阅读权限95
在线时间 小时
& & With CreateObject(&Scripting.Dictionary&)
& && &&&For i = 2 To Range(&C1048576&).End(xlUp).Row
& && && && &If Cells(i, 3).Value = &昨日& Or Cells(i, 3).Value = &上周同期& Or Cells(i, 3).Value = &前7天日均& Then
& && && && && & .Item(Cells(i, 3).Value) = Cells(i, 1).Resize(1, 8)
& && && && &End If
& && &&&Next
& && &&&Sheet1.Range(&A1&).Resize(1, 8).Copy Sheet2.Range(&A1&)
& && &&&Sheet2.Range(&A2&).Resize(.Count, 8) = Application.Rept(.items, 1)
& & End With
阅读权限95
在线时间 小时
本帖最后由 zax010 于
20:36 编辑
参考附件：
(19.67 KB, 下载次数: 263)
20:36 上传
点击文件名下载附件
阅读权限10
在线时间 小时
李甲 发表于
既然用VBA，就可以脱离既定工具
用数组，条件再多也不怕
虽然整体效果没有想象好
要考虑效率的问题,用循环始终是最后才选择的办法
阅读权限20
在线时间 小时
zax010 发表于
& & With CreateObject(&Scripting.Dictionary&)
& && &&&For i = 2 To Range(&C1048576&).End( ...
Application.Rept(.items, 1) 是什麽意思? 怎麽用法?
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 3663|回复: 16
用VBA编写代码求对筛选后的数据的最大值、最小值和标准差
阅读权限20
在线时间 小时
有哪位高手能帮忙怎样用VBA编写代码，求筛选后的数据的最大值、最小值和标准差，非常感谢！
21:13 上传
点击文件名下载附件
9.86 KB, 下载次数: 26
阅读权限95
在线时间 小时
请测试Sub 宏1()
& & Dim cnn As Object, SQL$
& & Set cnn = CreateObject(&ADODB.Connection&)
& & cnn.Open &Provider = Microsoft.Ace.Oledb.12.0;Extended Properties =Excel 12.0;Data Source =& & ThisWorkbook.FullName
& & SQL = &Select max(值),min(值),STDEV(值) from [Sheet1$] where Remark=true& '不懂什么是“标准差”，STDEV只是一个Excel公式
& & [h1].Resize(, 3) = Array(&最大值&, &最小值&, &标准差&)
& & [h2].CopyFromRecordset cnn.Execute(SQL)
& & cnn.Close
& & Set cnn = Nothing
End Sub
阅读权限95
在线时间 小时
(18.57 KB, 下载次数: 58)
22:05 上传
点击文件名下载附件
阅读权限95
在线时间 小时
eddie_cooler 发表于
provider 后面那一长串是什么？需要额外安装什么东西或是特别的设置才能用吗？就像HTML Object.
一、provider 后面那一长串是：连接对象的连接字符串，用于建立到数据源的连接
Provider = Microsoft.Ace.Oledb.12.0;Extended Properties =Excel 12.0;是连接提供者名称
Data Source =& & ThisWorkbook.FullName是数据源名称
二、windows已经安装好了ADO各个连接文件，见下图：
未命名.JPG (41.58 KB, 下载次数: 0)
01:40 上传
采用后期绑定Set cnn = CreateObject(&ADODB.Connection&)，程序会自动连接到需要的连接文件，不用额外安装什么东西
阅读权限20
在线时间 小时
zhaogang1960 发表于
一、provider 后面那一长串是：连接对象的连接字符串，用于建立到数据源的连接
Provider = Microsoft. ...
多谢版主大人，回答我这么没营养的问题
ps刚发现，出错原因是我的vb编辑窗口不能输入中文，必须要同时把代码和文档里的列标题改成英文。。。
再ps，SQL写的代码真的好简洁
阅读权限20
在线时间 小时
& & & & & & & &
我也写了一个。楼主的要求写成formula更好吧，可惜不知道怎么处理很多数据Sub mystats()
Dim a() As Double
Dim i, j As Integer
j = 0
For i = 2 To Application.CountA(Range(&A:A&))
If Cells(i, 6) = True Then
j = j + 1
ReDim Preserve a(j - 1)
a(j - 1) = Cells(i, 4)
End If
Next
Cells(4, 7) = Application.Max(a)
Cells(5, 7) = Application.Min(a)
Cells(6, 7) = Application.StDev(a)
Erase a
End Sub
复制代码
阅读权限95
在线时间 小时
eddie_cooler 发表于
我也写了一个。楼主的要求写成formula更好吧，可惜不知道怎么处理很多数据
思路不错，使用数组处理以加快速度：Sub mystats()
& & Dim a() As Double
& & Dim i As Long, j As Integer
& & Dim arr
& &
& & arr = Range(&a1&).CurrentRegion
& & ReDim a(1 To UBound(arr))
& &
& & For i = 2 To UBound(arr)
& && &&&If arr(i, 6) = True Then
& && && && &j = j + 1
& && && && &a(j) = arr(i, 4)
& && &&&End If
& & Next
& & ReDim Preserve a(1 To j)
& &
& & Cells(4, 7) = Application.Max(a)
& & Cells(5, 7) = Application.Min(a)
& & Cells(6, 7) = Application.StDev(a)
& & Erase a
& &
End Sub
复制代码
阅读权限20
在线时间 小时
zhaogang1960 发表于
思路不错，使用数组处理以加快速度：
我把你的代码copy过来结果报错说provider not found，是要在reference里选什么吗？
阅读权限95
在线时间 小时
eddie_cooler 发表于
我把你的代码copy过来结果报错说provider not found，是要在reference里选什么吗？
哪个代码？
(20.37 KB, 下载次数: 35)
00:22 上传
点击文件名下载附件
阅读权限20
在线时间 小时
zhaogang1960 发表于
哪个代码？
第一个，有用到SQL的。话说跟数据库有关吗？就学过一点点access
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师