Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2037|回复: 5

[已解决]请论坛老师帮忙写段查找并复制的代码

[复制链接]
发表于 2012-11-22 16:45 | 显示全部楼层 |阅读模式
工作薄1和工作薄2处于打开的状态,现需要从工作薄2“表2”中的A4:A1202区域中查找一个与工作薄1“表1”的G2相同的值,并把这个值的以下50行的数值拷贝到工作薄1“表1”的以G3为开始的区域中。

假如工作薄2“表2”的A1000与工作薄1“表1”的G2相同,则拷贝工作薄2“表2”的A1001:B1050的值到工作薄1“表1”的G3:H52中。(与工作薄1“表1”的G2相同的值,在工作薄2“表2”的位置不确定,也许是A100,也是A2000,但都是A列。如是A100的话,就复制A101:B150的值到工作薄1“表1”中。)谢谢各位论坛老师!!!

查找复制.rar (19.73 KB, 下载次数: 9)
发表于 2012-11-22 18:30 | 显示全部楼层    本楼为最佳答案   
本帖最后由 zjdh 于 2012-11-24 09:17 编辑

真有你的:工作簿 写成了工作薄
害得我老是调不出来!

查找复制.rar (28.81 KB, 下载次数: 28)
回复

使用道具 举报

 楼主| 发表于 2012-11-22 18:48 | 显示全部楼层
哈哈,都怪我马虎,写错了。谢谢论坛老师。问题解决了。
回复

使用道具 举报

发表于 2012-11-22 18:51 | 显示全部楼层

2楼附件刚才作了点小改动,工作簿未打开时,复制后可以跳回工作簿1。
回复

使用道具 举报

 楼主| 发表于 2012-11-23 09:38 | 显示全部楼层
还是原来的对,后改的有错误。
Sub TEST()
    On Error Resume Next
    Set WBook = Workbooks("工作簿2.xls")
    If WBook Is Nothing Then Workbooks.Open (ThisWorkbook.Path & "\工作簿2.xls")
    Set WBook = Workbooks("工作簿2.xls").Sheets(1)
    ARR = WBook.Range("A4:A" & WBook.Range("A65536").End(3).Row)
    With ThisWorkbook.Sheets(1)
    For I = 1 To UBound(ARR)
        If ARR(I, 1) = .Range("G2") Then
            WBook.Range("A" & I + 4 & ":B" & I + 53).Copy .Range("G3")
            Exit For
        End If
    Next
    ThisWorkbook.Activate
    End With
End Sub
回复

使用道具 举报

发表于 2012-11-24 09:19 | 显示全部楼层
本帖最后由 zjdh 于 2012-11-24 09:20 编辑

噢,一个变量名称忘了修改:
Sub TEST()
    On Error Resume Next
    Set WBook = Workbooks("工作簿2.xls")
    If WBook Is Nothing Then Workbooks.Open (ThisWorkbook.Path & "\工作簿2.xls")
    Set sh = Workbooks("工作簿2.xls").Sheets(1)
    ARR = sh.Range("A4:A" & sh.Range("A65536").End(3).Row)
    With ThisWorkbook.Sheets(1)
    For I = 1 To UBound(ARR)
        If ARR(I, 1) = .Range("G2") Then
            sh.Range("A" & I + 4 & ":B" & I + 53).Copy .Range("G3")
            Exit For
        End If
    Next
    ThisWorkbook.Activate
    End With
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 06:39 , Processed in 0.520213 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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