Question

我在办公室做报告。 Struckup在一点上，所以需要你的帮助或建议。

我有3个不同的工作表包含“Emp Name”和他们的“Emp ID”。（注意：订单顺序不一样）。如果我在第三栏中的一张纸（即）中输入工作时间，则相同的工作时间也要在其他纸张中复制。请告诉我解决方案。

请以下面的例子为例。

在工作表1中：

Name    Emp ID
AAA     123456
BBB     154658
CCC     178954

在工作表2中：

Name    Emp ID
BBB     154658
CCC     178954
AAA     123456

我有以下代码，但是它的副本和头文件从Worksheet1到Worksheet2已经存在于特定文件夹中。我需要从Worksheet1将第三列和第四列复制并删除到Worksheet2，但名称和emp id与Worksheet1不同。

Sub copydata()
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shttocopy As Worksheet
    Dim wbname As String
    ' check if the file is open
    ret = Isworkbookopen("H:\Srikanth\Book2.xlsm")
    If ret = False Then
        ' open file
        Set wkbSource = Workbooks.Open("H:\Srikanth\Book2.xlsm")
    Else
        'Just make it active
        'Workbooks("C:\stack\file1.xlsx").Activate
        Set wkbSource = Workbooks("Book2.xlsm")
    End If
    ' check if the file is open
    ret = Isworkbookopen("H:\Srikanth\Book1.xlsx")
    If ret = False Then
        ' open file
        Set wkbDest = Workbooks.Open("H:\Srikanth\Book1.xlsx")
    Else
        'Just make it active
        'Workbooks("C:\stack\file2.xlsx").Activate
        Set wkbDest = Workbooks("Book1.xlsx")
    End If
    'perform copy
    Set shttocopy = wkbSource.Sheets("filedata")
    shttocopy.Copy wkbDest.Sheets(3)
End Sub
Function Isworkbookopen(filename As String)
    Dim ff As Long, ErrNo As Long
    Dim wkb As Workbook
    Dim nam As String
    wbname = filename
    On Error Resume Next
    ff = FreeFile()
    Open filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
        Case 0 : Isworkbookopen = False
        Case 70 : Isworkbookopen = True
        Case Else : Error ErrNo
    End Select
End Function

Answer 1

如果使用VLOOKUP实现相同而不是编写VBA代码，那将非常简单。

使用公式的好处是：

更易于编辑和理解
结果更快，重量更轻。

在不同的工作簿中查找并粘贴

1 个答案: