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

潜行诡瀛

我想将sheet2中L列的数据，查找对应的sheet1中L列数据，并将sheet1中L列对应数据的整行，剪切到sheet2中L列对应数据的整行中。小白求助，求高手们帮忙实现该功能，万分感谢啊！大佬们！ 部分数据，剪切到sheet2中.zip (40.99 KB, 下载次数: 132)

2019-10-4 15:13 上传

点击文件名下载附件

microyip

论坛里大把类似代码，搜索，抄一下吧

gxp1986

一.模拟的数据里,没有标出效果要求(查找总要有对比的数据吧,你要对比哪个?).
二.后两列的日期,让我强迫症又犯了

潜行诡瀛

microyip 发表于 2019-10-4 15:32
论坛里大把类似代码，搜索，抄一下吧

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

潜行诡瀛

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

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

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

gxp1986

1. 
   

复制代码

写在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
    
34. 
    

复制代码

潜行诡瀛

gxp1986 发表于 2019-10-4 16:19
写在sheet2里面

万分感谢大佬

dushaguo

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

dushaguo

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比较慢，你可以赋值，

潜行诡瀛

gxp1986 发表于 2019-10-4 16:19
写在sheet2里面，注意，如果表1里有多个相同的值，只会返回第一个结果

大佬.......有一个小问题，能实现剪切吗？  Rows(k).Delete  ？？