Question

我是VB脚本的新手，所以我需要帮助来执行以下任务。我需要的是做三件事：

将工作表1的col A的值与工作表2的col A的任意行中的值相匹配。
如果匹配则必须将该值复制到同一工作簿中新工作表的col A中。
现在，工作表2的剩余col，即col B和更多将被附加并复制到我们之前复制匹配的col A值的新工作表。

例如：
Sheet1数据：

employeeName   ID  Dept
Mohan          1   IT

Sheet2数据：

employeeName   ID  In time      Out time
Gyaan          2   12:00:00 PM  10:15:00 PM
Mohan          1   09:02:00 AM  11:01:00 PM

现在Sheet 3应该有：

employeeName   ID  Intime       Out time
Mohan          1   09:02:00 AM  11:01:00 PM

这都在同一个工作簿中，需要使用VBA完成。

Answer 1

将此代码放在工作簿中的Module中并执行run（）子代码。这假设您的工作表的代码名称是Sheet1，Sheet2和Sheet3，如您所述。

Sub run()

    Dim row As Integer, sheet2Row As Integer
    row = 2

    With Sheet1
        Do While (.Cells(row, 1) <> "")
            sheet2Row = findInSheet2(.Cells(row, 1))
            If sheet2Row <> 0 Then copyRow (sheet2Row)
            row = row + 1
        Loop
    End With

End Sub

Function findInSheet2(text As String) As Integer

    Dim found As Range

    With Sheet2
        Set found = .Columns(1).Find(What:=text, MatchCase:=True)
        If Not found Is Nothing Then
            findInSheet2 = found.row
        Else
            findInSheet2 = 0
        End If
    End With

End Function

Sub copyRow(row As Integer)

    Sheet2.Rows(row).Copy
    Sheet3.Rows(getSheet3LastRow).PasteSpecial

End Sub

Function getSheet3LastRow()

    Dim found As Range

    Set found = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then
        getSheet3LastRow = found.row + 1
    Else
        getSheet3LastRow = 1
    End If

End Function

如果一个工作表的列值与excel 2010中的另一个工作表匹配，则复制新工作表中的值

1 个答案: