excel中用vba查询access中符合条件的数据，并且依次导出_百度知道查看: 2774|回复: 12
如何将符合条件的数据提取到另一张表
阅读权限20
在线时间 小时
本帖最后由 gold_bless 于
15:37 编辑
(17.07 KB, 下载次数: 107)
15:34 上传
点击文件名下载附件
如题，如何使用VBA将《明细表》中的数据提取到《汇总表》中，要求是不再考虑明细表中的工厂，只要前四列唯一，就在汇总表中占据一行，不同工厂的要求和。
附件中汇总是用数据透视表做的，但数据经常变，每次使用数据透视表很麻烦。
阅读权限70
在线时间 小时
两个文件是在同一个文件夹里面吗
阅读权限95
在线时间 小时
Sub test()
&&Dim cnn As New ADODB.Connection
&&Dim rs As New ADODB.Recordset
&&Dim SQL As String
&&Dim mybook As String
&&mybook = ThisWorkbook.FullName
&&With cnn
& & If Application.Version = &11.0& Then
& && &.Provider = &microsoft.jet.oledb.4.0&
& && &.ConnectionString = &extended properties=&&excel 8.0;HDR=YES;&&;data source=& & mybook
& & Else
& && &.Provider = &microsoft.ACE.oledb.12.0&
& && &.ConnectionString = &extended properties=&&excel 12.0;HDR=YES;&&;data source=& & mybook
& & End If
& & .Open
&&End With
&&SQL = &select 客户名称,产品大类,系列号,产品,sum([1月]) as 1月,sum([2月]) as 2月,sum([3月]) as 3月,sum([4月]) as 4月,sum([5月]) as 5月,sum([6月]) as 6月,sum([7月]) as 7月,sum([8月]) as 8月,sum([9月]) as 9月,sum([10月]) as 10月,sum([11月]) as 11月,sum([12月]) as 12月 from [excel 8.0;database=& & ThisWorkbook.Path & &\明细.xls].[明细表$a1:q] group by 客户名称,产品大类,系列号,产品&
&&rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
&&With Worksheets(&sheet2&)
& & .Cells.Delete
& & For j = 0 To rs.Fields.Count - 1
& && &.Cells(1, j + 1) = rs.Fields(j).Name
& & Next
& & .Range(&a2&).CopyFromRecordset rs
&&End With
End Sub
复制代码
阅读权限95
在线时间 小时
详见附件。
15:57 上传
点击文件名下载附件
18.18 KB, 下载次数: 242
阅读权限20
在线时间 小时
lanseqingren 发表于
两个文件是在同一个文件夹里面吗
是的！明细表是别人发给我的，我会放在一个文件夹
阅读权限20
在线时间 小时
chxw68 发表于
这么快就做好了！真是太感谢你了！
我要好好研究一下，我经常有这些问题要解决！
上次就是您帮我解决了问题，效率提高了很多，再次感谢你！
阅读权限20
在线时间 小时
我把汇总表放到明细表里，你看下是否是你所要。
16:37 上传
点击文件名下载附件
13.38 KB, 下载次数: 125
阅读权限20
在线时间 小时
yryxqg 发表于
我把汇总表放到明细表里，你看下是否是你所要。
谢谢你！这个的确能满足我要求！
我这次想用VBA，因为汇总表中前四列的数据也会变！生产的东西不一样，每个月数据就不一样！
阅读权限20
在线时间 小时
chxw68 发表于
详见附件。
遇到点问题，就是我的“系列号”一列，有的不是数值（我例子中都是数值），在汇总表中就会为空，
还有就是明细表中间的空行也会在汇总表有空行。
阅读权限95
在线时间 小时
& & & & & & & &
gold_bless 发表于
遇到点问题，就是我的“系列号”一列，有的不是数值（我例子中都是数值），在汇总表中就会为空， ...
在用SQL提取数据时，如果一列里既有数值型也有非数值型数据，就可能提取不到有的类型数据。就像在标准的数据库文件中，每个字段类型是明确的，也是统一的。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 629|回复: 8
根据条件筛选出符合条件的数据
阅读权限20
在线时间 小时
各位大侠，我有一些数据，需要根据多条件从数据源中筛选出符合条件的数据并生成到制定区域，请各位大侠帮忙解决，谢谢！
09:14 上传
点击文件名下载附件
8.35 KB, 下载次数: 12
阅读权限20
在线时间 小时
首先，用表函数的话，因为你是有4个条件，而且暂时估计，这4个条件可以缺失某个，或者可以有或的关系，这样的话 表函数非常麻烦；其次，用vba的话，也许各种条件逻辑考虑清楚后，能达到你想要的目的，能筛选出结果，但是针对排序会很麻烦，所以，综上所述，推荐用数据库的方法~
阅读权限20
在线时间 小时
首先，用表函数的话，因为你是有4个条件，而且暂时估计，这4个条件可以缺失某个，或者可以有或的关系，这样 ...
如果不针对排序呢？能否实现呢？该怎么弄？
阅读权限95
在线时间 小时
Sub test()
&&Dim r%, i%
&&Dim arr, brr
&&Dim flg As Boolean
&&Set d1 = CreateObject(&scripting.dictionary&)
&&Set d2 = CreateObject(&scripting.dictionary&)
&&Set d3 = CreateObject(&scripting.dictionary&)
&&With Worksheets(&sheet1&)
& & arr = .Range(&b2:e3&)
& & For j = 1 To UBound(arr, 2)
& && &If Len(arr(2, j)) && 0 Then
& && &&&d1(arr(1, j)) = arr(2, j)
& && &End If
& & Next
& & arr = .Range(&a9:h9&)
& & For j = 1 To UBound(arr, 2)
& && &d2(arr(1, j)) = j
& & Next
&&End With
&&With Worksheets(&数据源&)
& & r = .Cells(.Rows.Count, 2).End(xlUp).Row
& & arr = .Range(&a1:m& & r)
& & ReDim brr(1 To UBound(arr), 1 To d2.Count)
& & For j = 1 To UBound(arr, 2)
& && &xm = Replace(arr(1, j), Chr(10), &&)
& && &d3(xm) = j
& & Next
& & flg = True
& & For Each aa In d1.keys
& && &If Not d3.exists(aa) Then
& && &&&flg = False
& && &&&Exit For
& && &End If
& & Next
& & If flg Then
& && &For i = 2 To UBound(arr)
& && &&&flg = True
& && &&&For Each aa In d1.keys
& && && & If arr(i, d3(aa)) && d1(aa) Then
& && && && &flg = False
& && && && &Exit For
& && && & End If
& && &&&Next
& && &&&If flg Then
& && && & m = m + 1
& && && & For j = 1 To UBound(arr, 2)
& && && && &xm = Replace(arr(1, j), Chr(10), &&)
& && && && &If d2.exists(xm) Then
& && && && &&&brr(m, d2(xm)) = arr(i, j)
& && && && &End If
& && && & Next
& && &&&End If
& && &Next
& & End If
& &
&&End With
&&With Worksheets(&sheet1&)
& & .Range(&a10&).Resize(UBound(brr), UBound(brr, 2)) = brr
&&End With
End Sub
复制代码
阅读权限95
在线时间 小时
详见附件。
15:57 上传
点击文件名下载附件
13.8 KB, 下载次数: 24
阅读权限90
在线时间 小时
Sub yy() 'hlly888
Range(&b10:h65536&).ClearContents
Application.ScreenUpdating = False
Dim arr, yr, i&, x&, s&
x = Sheets(&数据源&).Cells(Rows.Count, 2).End(xlUp).Row
arr = Sheets(&数据源&).Range(&b2:m& & x)
yr = Range(&b3:e3&)
ReDim brr(1 To UBound(arr), 1 To 8)
& &
& & For i = 1 To UBound(arr)
& && &&&If arr(i, 3) = yr(1, 1) And arr(i, 4) = yr(1, 2) And arr(i, 10) = yr(1, 3) And arr(i, 9) = yr(1, 4) Then
& && && &&&s = s + 1
& && && &&&brr(s, 1) = arr(i, 3)
& && && &&&brr(s, 2) = arr(i, 4)
& && && &&&brr(s, 3) = arr(i, 7)
& && && &&&brr(s, 4) = arr(i, 10)
& && && &&&brr(s, 5) = arr(i, 9)
& && && &&&brr(s, 6) = arr(i, 11)
& && && &&&brr(s, 7) = arr(i, 12)
& && &&&End If
& & Next
[b10].Resize(s, 7) = brr
Range(&b10:h& & s + 9).Sort key1:=Range(&d10&)
Application.ScreenUpdating = True
End Sub复制代码
阅读权限90
在线时间 小时
(21.12 KB, 下载次数: 19)
16:47 上传
点击文件名下载附件
阅读权限95
在线时间 小时
& & ar = Sheet2.Range(&A1&).CurrentRegion
& & a1 = [b3]: a2 = [c3]: a3 = [d3]: a4 = [e3]
& & ReDim br(1 To 500, 1 To 8)
& & For i = 2 To UBound(ar)
& && &&&If ar(i, 4) = a1 And ar(i, 5) = a2 And ar(i, 10) = a3 And ar(i, 11) = a4 Then
& && && && &m = m + 1
& && && && &br(m, 1) = ar(i, 1): br(m, 2) = ar(i, 4): br(m, 3) = ar(i, 5): br(m, 4) = ar(i, 8)
& && && && &For j = 5 To 8
& && && && && & br(m, j) = ar(i, j + 5)
& && && && &Next
& && &&&End If
& & Sheet1.[a10].Resize(m, 8) = br
阅读权限95
在线时间 小时
&&&&&&&&&&&&&&&&&&&&&&&
(13.55 KB, 下载次数: 10)
17:33 上传
点击文件名下载附件
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师君，已阅读到文档的结尾了呢~~
如何通过VBA编程将符合条件的数据库记录输入到EXCEL中
扫扫二维码，随身浏览文档
手机或平板扫扫即可继续访问
如何通过VBA编程将符合条件的数据库记录输入到EXCEL中
举报该文档为侵权文档。
举报该文档含有违规或不良信息。
反馈该文档无法正常浏览。
举报该文档为重复文档。
推荐理由：
将文档分享至：
分享完整地址
文档地址：
粘贴到BBS或博客
flash地址：
支持嵌入FLASH地址的网站使用
html代码：
&embed src='/DocinViewer-4.swf' width='100%' height='600' type=application/x-shockwave-flash ALLOWFULLSCREEN='true' ALLOWSCRIPTACCESS='always'&&/embed&
450px*300px480px*400px650px*490px
支持嵌入HTML代码的网站使用
您的内容已经提交成功
您所提交的内容需要审核后才能发布，请您等待！
3秒自动关闭窗口