ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6701|回复: 32

[求助] 求助VBA中怎么将对应的sheet1的整行数据剪切到sheet2中

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-4 15:14 | 显示全部楼层 |阅读模式
我想将sheet2中L列的数据,查找对应的sheet1中L列数据,并将sheet1中L列对应数据的整行,剪切到sheet2中L列对应数据的整行中。小白求助,求高手们帮忙实现该功能,万分感谢啊!大佬们! 部分数据,剪切到sheet2中.zip (40.99 KB, 下载次数: 132)


TA的精华主题

TA的得分主题

发表于 2019-10-4 15:32 | 显示全部楼层
论坛里大把类似代码,搜索,抄一下吧

TA的精华主题

TA的得分主题

发表于 2019-10-4 15:47 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
一.模拟的数据里,没有标出效果要求(查找总要有对比的数据吧,你要对比哪个?).
二.后两列的日期,让我强迫症又犯了

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-4 15:49 | 显示全部楼层
microyip 发表于 2019-10-4 15:32
论坛里大把类似代码,搜索,抄一下吧

大佬,类似帖子看很多,我一直没有找到适用的啊,自己乱改了改也一直没改好。大佬,能不能帮忙看一下哦?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-4 15:57 | 显示全部楼层
gxp1986 发表于 2019-10-4 15:47
一.模拟的数据里,没有标出效果要求(查找总要有对比的数据吧,你要对比哪个?).
二.后两列的日期,让我强迫症 ...

大佬,sheet2的L列的每一个单元格对应sheet1的L列数据,比如sheet2中L列  111   这个数据对应的sheet1的L列数据  111  ,将sheet1中111 数据所在一行剪切到sheet2 111所在的一行

后两列日期。。。。。。请无视它吧,大佬。实在看不惯,删了也行

TA的精华主题

TA的得分主题

发表于 2019-10-4 16:19 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 gxp1986 于 2019-10-4 17:23 编辑

复制代码
写在sheet2里面,注意,如果表1里有多个相同的值,只会返回第一个结果
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim tr As Long, tl As Long, i As Long, k As Long, n As Long, ss As Variant
  3.     n = Target.Count
  4.     If n > 1000 Then Exit Sub       '当一次性操作操作1000个单元格时,不触发本程序
  5.     If Target.Cells(1).Column = 12 Then
  6.         For i = 1 To n
  7.             tr = Target.Cells(i).Row
  8.             tl = Target.Cells(i).Column
  9.             If tl = 12 Then
  10.                 ss = Target.Cells(i)
  11.                 If ss = "" Then
  12.                     Rows(tr).ClearContents     '当L列数据为空时,清空本行
  13.                 Else
  14.                     For k = 1 To 10000
  15.                         With Sheet1
  16.                             If .Cells(k, "L") = ss Then
  17.                                 Application.EnableEvents = False
  18.                                     Rows(tr) = .Rows(k).Value               '当数值相等时,返回匹配到的数据,并退出程序
  19.                                    .Rows(k).Delete                                '删除表1里的数据
  20.                                 Application.EnableEvents = True
  21.                                 Exit Sub
  22.                             End If
  23.                         End With
  24.                     Next
  25.                     Application.EnableEvents = False
  26.                         Rows(tr).ClearContents     '当匹配不到数据时,清空本行,并还原数值
  27.                         Target.Cells(i) = ss
  28.                      Application.EnableEvents = True
  29.                 End If
  30.             End If
  31.         Next
  32.     End If
  33. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-4 16:20 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-10-4 16:29 | 显示全部楼层
Sub copy1() Dim r, x  r = Sheet1.UsedRange.Rows.Count  x = Sheet2.UsedRange.Rows.Count  arr = Sheet2.Range("l1:l" & x)   For i = 1 To r  For j = 1 To x     If Sheet2.Range("l" & j) = Sheet1.Range("l" & i) Then     Sheet1.Range("a" & i).Resize(, 9).Copy Sheet2.Range("a" & j).Resize(, 9)      End If Next  Next End Sub

TA的精华主题

TA的得分主题

发表于 2019-10-4 16:30 | 显示全部楼层
Sub copy1()
Dim r, x
r = Sheet1.UsedRange.Rows.Count
x = Sheet2.UsedRange.Rows.Count
arr = Sheet2.Range("l1:l" & x)

For i = 1 To r
For j = 1 To x
    If Sheet2.Range("l" & j) = Sheet1.Range("l" & i) Then
    Sheet1.Range("a" & i).Resize(, 9).Copy Sheet2.Range("a" & j).Resize(, 9)

    End If
Next
Next
End Sub
copy比较慢,你可以赋值,

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-4 16:53 | 显示全部楼层
gxp1986 发表于 2019-10-4 16:19
写在sheet2里面,注意,如果表1里有多个相同的值,只会返回第一个结果

大佬.......有一个小问题,能实现剪切吗?  Rows(k).Delete  ??
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 20:30 , Processed in 0.056523 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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