[已解决][求助] .按条件提取所需要数据

新会甜橙

资料表的R列和提取明细表的F列核对,(资料表R列重复的只提取第1条),提取资料表的NOPQE单元格到对应提取明细表ABCDE单元格
[求助] .按条件提取所需要数据

最佳答案

月排行榜 / 总排行榜

风化石

2012-11-14 09:08

Sub Macro1()
Application.ScreenUpdating = False  '禁用刷新
With Sheets("资料表")
x = .Range("R65536").End(xlUp).Row
y = Range("F65536").End(xlUp).Row
For i = 2 To y
If IsNumeric(Application.Match(Cells(i, 6), .Range("R1:R" & x), 0)) Then
m = Application.Match(Cells(i, 6), .Range("R1:R" & x), 0) ' 行数
.Range("N" & m & ":Q" & m).Copy Cells(i, 1)
.Range("E" & m).Copy Cells(i, 5)
End If
Next
End With
End Sub
按条件填入数据.rar (12.37 KB, 下载次数: 32)

2012-11-14 09:11 上传

点击文件名下载附件

跳转到最佳答案楼层

风化石

Sub Macro1()
Application.ScreenUpdating = False  '禁用刷新
With Sheets("资料表")
x = .Range("R65536").End(xlUp).Row
y = Range("F65536").End(xlUp).Row
For i = 2 To y
If IsNumeric(Application.Match(Cells(i, 6), .Range("R1:R" & x), 0)) Then
m = Application.Match(Cells(i, 6), .Range("R1:R" & x), 0) ' 行数
.Range("N" & m & ":Q" & m).Copy Cells(i, 1)
.Range("E" & m).Copy Cells(i, 5)
End If
Next
End With
End Sub
按条件填入数据.rar (12.37 KB, 下载次数: 32)

2012-11-14 09:11 上传

点击文件名下载附件

新会甜橙

风化石 发表于 2012-11-14 09:08
Sub Macro1()
Application.ScreenUpdating = False  '禁用刷新
With Sheets("资料表")

谢谢老师帮助符合要求