在sheet1和sheet2中搜索相同的值,并将值从sheet1复制到sheet2

时间:2015-10-22 09:38:41

标签: excel vba excel-vba

我和excel一起工作但不是很擅长VBA,所以我需要帮助制作一个宏,我不能让录音宏工作:(

我有一张包含2张(Sheet1和Sheet2)的Excel文件。

我想将Sheet2(A列)中的文本与sheet1(B列)进行比较,如果它在两个工作表中都找到相同的文本,那么我是否希望宏将sheet1中的A,B,C和D列复制到sheet2中的B,C,D和E列。

在表1中,我有超过6000行,所以我不想手动执行此操作或在excel中执行公式,我想要一个为我执行此操作的宏。

这些床单有标题,有人可以帮我这个吗?

1 个答案:

答案 0 :(得分:0)

我有点不清楚你要做什么。这是我的解释:假设,对于工作表1中第X行A列中的值 - 如果在第Y行B列中的工作表2上找到相应的值 - 您希望从工作表1复制第X行所属的单元格到ABCD列并将它们粘贴在第Y行BCD E页2中。

如果这是正确的,请尝试:

Sub copyCells()
    Dim wb As Workbook, firstWs As Worksheet, secondWs As Worksheet
    Dim matchIndex As Integer

    Set wb = ThisWorkbook
    Set firstWs = wb.Worksheets(1)
    Set secondWs = wb.Worksheets(2)

    Application.ScreenUpdating = False

    ' We'll start at i=2 to account for the header
    For i = 2 To firstWs.Range("A2:A6000").Rows.count
        On Error Resume Next
        ' MATCH will find the row number in sheet 2 - change the range specifications as needed
        matchIndex = Application.WorksheetFunction.Match(firstWs.Range("A" & i), secondWs.Range("B2:B6000"), 0)
        Err.Clear
        On Error GoTo 0

        ' MATCH will throw an error if it finds no results.
        ' Hence: if matchindex contains an error, do nothing.
        ' But if it doesn't contain an error, it must contain a row number - so we can proceed.
        If Not Application.WorksheetFunction.IsNA(matchIndex) Then
            secondWs.Range("B" & matchIndex).Value = firstWs.Range("A" & i).Value
            secondWs.Range("C" & matchIndex).Value = firstWs.Range("B" & i).Value
            secondWs.Range("D" & matchIndex).Value = firstWs.Range("C" & i).Value
            secondWs.Range("E" & matchIndex).Value = firstWs.Range("D" & i).Value    
        End If
    Next i

    Application.ScreenUpdating = True
End Sub