搜索并将sheet1中的列粘贴到sheet2

时间:2015-04-10 18:48:35

标签: excel excel-vba vba

我尝试从sheet1进行搜索,复制和粘贴到sheet2。首先,我需要在sheet2中搜索列的值,然后匹配sheet1中的值,然后复制然后将整行粘贴到sheet2。例如,我有以下数据

Sheet 2中

A   B    C         D    E   F
        1200-24                 
        1201-24                 
        120-24                  
        1218-24                 

Sheet 1中

A  B   C           D     E      F   
2 345  1200-24     ABD   1er    3.4     
3 456  1201-24     CDF   de3    6.6     
7 780  120-24      EFg   d45    9.6 
9 657  1218-24     VGA   9ml    8.7

所以我希望在工作表1上搜索来自工作表2上的c1的所有数据,如果匹配则粘贴到第2行第2页,在工作表2上搜索要在工作表1上搜索的c2,如果匹配则粘贴到第3行第2页等等。

我从这个网站找到了这段代码:

Sub SearchForString()

Dim LCopyToRow As Integer


On Error GoTo Err_Execute


'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

Dim sheetTarget As String: sheetTarget = "sheet2"
Dim sheetToSearch As String: sheetToSearch = "sheet1"
Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("C2").Value  'Value in sheet2!A1 to be searched in sheet1
Dim columnToSearch As String: columnToSearch = "C"
Dim iniRowToSearch As Integer: iniRowToSearch = 2
Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
Dim maxRowToSearch As Long: maxRowToSearch = 2000 'There are lots of rows, so better setting a max. limit

If (Not IsEmpty(targetValue)) Then
    For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count

        'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
        If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then

            'Select row in Sheet1 to copy
            Sheets(sheetToSearch).Rows(LSearchRow).Copy

            'Paste row into Sheet2 in next row
            Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
        End If

        If (LSearchRow >= maxRowToSearch) Then
            Exit For
        End If

    Next LSearchRow

    'Position on cell A1
    Application.CutCopyMode = False
    Range("A1").Select

    MsgBox "All matching data has been copied."
End If

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

但它不会让我从sheet2上的c2移动到c3,而且代码LCopyToRow = LCopyToRow + 1,而不是移动到sheet2上的下一行。 非常感谢您的帮助。 谢谢

EDITED: 我改变了行Dim targetValue As String:targetValue = Sheets(sheetTarget).Range(“C2”)。Value ---->>它是范围(“A2”)。谢谢

1 个答案:

答案 0 :(得分:0)

如果您要查看的是将所有单元格从一行复制到另一页,请学习使用匹配和索引函数。

匹配函数将返回与您要搜索的内容相匹配的行号。将匹配函数放在一列中以找到该行。然后使用索引公式从行中复制数据。使用匹配行列值作为行参数,为每个所需列重复索引函数。

这非常有效,因为您只搜索每个值一次,但通过索引多次复制数据。它比使用嵌套循环更快地执行查找。

设置公式以链接和提取数据后,您可以使用宏录制器将公式存储在代码中,以便您可以从电子表格向下复制它们,从上到下传输值。之后,您可以将整个工作表的粘贴值复制为仅包含数据。

您还可以将公式保留在第二行,以便将工作表用作将来副本的模板。然后,您只需粘贴搜索值列并复制公式。我是否提到您可以按照与源工作表不同的顺序排列列,以及随时对新工作表进行排序,并将行正确链接到源数据。