查看: 558|回复: 4
如何根据窗体中的条件去查询文件夹内文件的数据并复制到工作表中
阅读权限10
在线时间 小时
QQ图片07.png (12.04 KB, 下载次数: 0)
21:40 上传
如何点击查询后，在符合月份的文件夹中，查询符合条件的文件的工作表1中的数据，并复制到当前工作表3中
查询结果后，在窗体中选 中数据，点击修改可以添加备注，并保存到原先的工作薄中，
急切，想解决查询的问题
(139.5 KB, 下载次数: 5)
21:46 上传
点击文件名下载附件
这是原表，及部分数据
阅读权限10
在线时间 小时
i都没有人回复的哦。。。。
自已上多找实在是搞不定哦，那些大神帮帮忙先。。。
阅读权限10
在线时间 小时
没有人帮忙，可不可以给建议，解决思路，或部分代码
阅读权限10
在线时间 小时
没人帮忙，自已上网找资料，整了一天，都没有整好，我想在查询前把文件夹的工作表数据都转到工作表“数据”里，然后再查询，应该会简单点。
找的的代码自己改了，但还是有些问题
Private Sub CommandButton3_Click()
& & Dim Arr, MyPath$, Myd$, wb As Workbook, sh As Worksheet, m&
& & Dim funm$, shnm$, col%, i&, Myr&, sht1 As Worksheet, pm$
& & Application.ScreenUpdating = False
& & On Error Resume Next
& & Set sh = Sheets(&数据&)
& &&&sh.[D2:G2000].ClearContents
& & MyPath = ThisWorkbook.Path & &\& & Format(Now, &MM&) & &月份账单\&
& & Myd = Dir(MyPath & &*.xlsx&)
& & Do While Myd && &&
& && &&&With GetObject(MyPath & Myd)
Set wb = Workbooks(Myd)
For Each sht1 In wb.Sheets
If sht1.Name = &日销售额原始清单& Then
& && &pm = sht1.[j5].Value
& && &Myr = sht1.[d65536].End(xlUp).Row
& && &Arr = sht1.Range(&d5:j& & Myr)
& && &m = m + 1
& && &With sh
& &&&.Range(&d& & m & &:d& & Myr + 7) = Left(Myd, Len(Myd) - 5)
& && &.Cells(m, 5).Resize(UBound(Arr), 4) = Arr
& && &.Cells(m, 6) = pm
& && &&&End With
& && & m = m + UBound(Arr) - 1
& && & End If
& && & Next
& && & .Close False
& && & End With
& && & Myd = Dir
ListBox3.ColumnCount = 7
& &ListBox3.RowSource = &数据!& & &D1:J& & Sheets(&数据&).Range(&D& & Rows.Count).End(xlUp).Row
& && &Loop
& & Application.ScreenUpdating = True
阅读权限10
在线时间 小时
眼要瞎了，心要吐血了，那个高手帮个忙吧，我真的太累了，但目前能力有限。。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 4687|回复: 15
求助VBA代码：根据条件查找另一表符合条件的数据拷贝到本表
阅读权限10
在线时间 小时
QQ截图43.png (7.43 KB, 下载次数: 1)
22:05 上传
QQ截图25.png (10.79 KB, 下载次数: 1)
22:05 上传
遍历表一的工号，从表二中查找符合条件的数据，将数据复制到表一对应的行中
(8.84 KB, 下载次数: 43)
22:07 上传
点击文件名下载附件
阅读权限100
在线时间 小时
& & & & & & & &
Sub 查找()
Dim arr, brr
Dim i, s As Integer
arr = Sheet1.Range(&a2&).CurrentRegion
&&brr = Sheet2.Range(&a3&).CurrentRegion
&&ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
&&n = 1
For i = 2 To UBound(arr)
For s = 2 To UBound(brr)
If arr(i, 1) = brr(s, 1) Then
crr(n, 1) = brr(s, 2): crr(n, 2) = brr(s, 3)
crr(n, 3) = brr(s, 4): crr(n, 4) = brr(s, 5)
n = n + 1
End If
Next s
Next i
With Sheet1
.Range(&b3&).Resize(UBound(crr), UBound(crr, 2)) = crr
s = .Columns(1).Cells(.Columns(1).Cells.Count).End(xlUp).Row
.Range(&a3:e& & s).Borders.LineStyle = xlContinuous
End With
End Sub
复制代码
阅读权限95
在线时间 小时
此类查询字典+数组法效率最高，请参考：
Private Sub CommandButton1_Click()
& & Dim arr, brr, crr(), d As Object, i&, j%, r
& & Set d = CreateObject(&scripting.dictionary&)
& & arr = Sheets(&Sheet2&).Range(&a4:e& & Sheets(&Sheet2&).Range(&a65536&).End(xlUp).Row)
& & For i = 1 To UBound(arr)
& && &&&d(arr(i, 1)) = i
& & Next
& & brr = Range(&a1:a& & Range(&a65536&).End(xlUp).Row)
& & ReDim crr(3 To UBound(arr), 2 To 5)
& & For i = 3 To UBound(brr)
& && &&&r = d(brr(i, 1))
& && &&&If r && && Then
& && && && &For j = 2 To 5
& && && && && & crr(i, j) = arr(r, j)
& && && && &Next
& && &&&End If
& & Next
& & Range(&B3&).Resize(i - 3, 4) = crr
End Sub
复制代码
23:06 上传
点击文件名下载附件
12.1 KB, 下载次数: 207
阅读权限20
在线时间 小时
楼上两位大神做得好，我用函数解决，容易懂vlookup
08:41 上传
点击文件名下载附件
9.49 KB, 下载次数: 32
阅读权限20
在线时间 小时
B4:VLOOKUP(A1,sheet2!$A$4:$E$252,2,FALSE)
C4:VLOOKUP(A1,sheet2!$A$4:$E$252,3,FALSE)
D4:VLOOKUP(A1,sheet2!$A$4:$E$252,4,FALSE)
E4:VLOOKUP(A1,sheet2!$A$4:$E$252,5,FALSE)
阅读权限10
在线时间 小时
非常感谢各位大神
阅读权限20
在线时间 小时
写的不错，学习了
阅读权限20
在线时间 小时
此类查询字典+数组法效率最高，请参考：
为什么把字典条目赋值给r，再判断r不等于空，这个r是不是数组，能不能解释下？
阅读权限95
在线时间 小时
为什么把字典条目赋值给r，再判断r不等于空，这个r是不是数组，能不能解释下？
r 是 Variant 类型变量
r = d(brr(i, 1))，如果字典存在，即d(brr(i, 1))有值，则 r 就是Sheet2对应的行号，如果字典不存在，则 r = &&
阅读权限20
在线时间 小时
r 是 Variant 类型变量
r = d(brr(i, 1))，如果字典存在，即d(brr(i, 1))有值，则 r 就是Sheet2对应的行 ...
是不是这里可以写成If&&d.exists(brr(i,1)) then&&这两种写法到底有什么区别？
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师14 条评论分享收藏感谢收起赞同 添加评论分享收藏感谢收起写回答2 个回答被折叠（）VBA中如何才能快速查找到excel表中符合某一条件的行？
[问题点数：0分]
本版专家分：0
结帖率 100%
CSDN今日推荐
本版专家分：90
本版专家分：90
本版专家分：0
本版专家分：10846
2004年12月 其他开发语言大版内专家分月排行榜第一2003年3月 其他开发语言大版内专家分月排行榜第一2003年2月 其他开发语言大版内专家分月排行榜第一2003年1月 其他开发语言大版内专家分月排行榜第一
2002年12月 其他开发语言大版内专家分月排行榜第二
2004年11月 其他开发语言大版内专家分月排行榜第三2004年10月 其他开发语言大版内专家分月排行榜第三
本版专家分：209
本版专家分：80
匿名用户不能发表回复！
其他相关推荐小白vba写程序查找所需要的sheet1对于列单元格判断是否为红色，满足条件后填写到sheet2对应单元格里_百度知道
小白vba写程序查找所需要的sheet1对于列单元格判断是否为红色，满足条件后填写到sheet2对应单元格里
规则是从页签sheet1中的A、B列的颜色判断，如果这两列有任意一列是红色的，这提取C、D列的数据放在Sheet2表中的E，F列...
规则是从页签sheet1中的A、B列的颜色判断，如果这两列有任意一列是红色的，这提取C、D列的数据放在Sheet2表中的E，F列
答题抽奖
首次认真答题后
即可获得3次抽奖机会，100%中奖。
来自电脑网络类芝麻团
采纳数：16634
获赞数：18863
参与团队：
这两列有任意一列是红色的，可否只判断A1、B1单元格，还是要从A1:A65536、B1:Bb65536都是红色？
判断每一行A列B列，只要有一单元格为红色，就取对应行C，D列单元格的数据放到sheet2里
下载附件。按按钮执行程序即可。Sub&按钮1_Click()lastrow&=&Cells(Rows.Count,&1).End(xlUp).Rowk&=&1For&i&=&1&To&lastrow&&&&Sheets(&Sheet1&).Select&&&&If&Cells(i,&1).Interior.ColorIndex&=&3&Or&Cells(i,&2).Interior.ColorIndex&=&3&Then&&&&&&&&Range(Cells(i,&3),&Cells(i,&4)).Select&&&&&&&&Selection.Copy&&&&&&&&Sheets(&Sheet2&).Select&&&&&&&&Cells(k,&5).Select&&&&&&&&ActiveSheet.Paste&&&&&&&&k&=&k&+&1&&&&End&IfNextEnd&Sub
为你推荐：
个人、企业类
违法有害信息,请在下方选择后提交
色情、暴力
我们会通过消息、邮箱等方式尽快将举报结果通知您。