设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 3299|回复: 4
打印 上一主题 下一主题

查询内容复制保存到新表,请高手指教,谢谢!

[复制链接]
跳转到指定楼层
1#
发表于 2016-3-15 13:48:46 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式


现在“查询”里已经有代码 在同表中显示查询结果  
该如何该代码 实现要把“周六户外活动日记账” 相同活动时间的条目通过窗体 查询出并复制到“费用记录查询”中
------------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()

With Sheets("周六户外活动日记账")
ActiveWindow.DisplayGridlines = False     '▼▼工作表隐藏网格线
Set frng = .Range("c:c").Find(TextBox1.Text, , , xlWhole)         '集frng =。范围(“:”),发现(textbox1.text文本,,xlwhole实例)  此4行不能重复保存
    If frng Is Nothing Then                             '如果不frng是没有然后
           MsgBox "以保存"                                 '本以保存”
           Exit Sub
    End If
End With

ends = Columns(1).Find("*", , , , , searchdirection:=xlPrevious).Row '动态找到A列的最后一个单元格
Range("k5:s65536").Clear '清除之前所有的筛选结果

For Each Rng In Range("c5:c" & ends)   '对("a5:a" & ends到最后一个有内容的单元格)做一个循环
     M = M + 1
     If Rng Like TextBox1.Value Then   '如果条件成立,那么
        Range("a" & M + 4 & ":i" & M + 4).Copy Range("k" & K + 4) '将记录复制到另一个区域
    End If

Next
End Sub


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2016-3-15 17:23:59 | 只看该作者
给几个建议吧:
1、尽量加上工作表名。否则会因为打开不同的工作表而导致不同的区域被操作,如下:
Range("k5:s65536").Clear
如果打开的是A工作表,那么删除的就是A表的数据;如果打开的是B表,则B表数据被删除。
2、如果没记错的话,copy之后,应该还有一个paste的。写法大概是:
selection.Copy
range("A1").active'建议加上这个,先激活单元格再粘贴。不激活是否能够粘贴则不太清楚。
range("A1").paste
3、如果表格规整写,可以用ADO来完成筛选的工作。但你的表头有合并单元格(最右边那两列)……
3#
发表于 2016-5-7 18:34:44 | 只看该作者
粗略看了下, 个人感觉没必要用find 来搜索   用for    +数组    like 对比文本    textbox1.text 里面的值可以写模糊值   
4#
发表于 2016-5-7 18:35:46 | 只看该作者
第二部分不因该循环单元格对象   因该先讲单元格对象的值给数组   只用读取一次对象
5#
发表于 2016-5-7 18:37:13 | 只看该作者
可将条件成立的数据写在入字典或者另一数组中  最后在一次将这些值赋值给“另一个区域”
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 12:37 , Processed in 0.089915 second(s), 30 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表