Question

我在工作簿中有两张Excel工作表，我希望在其间复制数据，但我无法弄清楚。我正在尝试调整先前答案here中的代码，但我无法按照我想要的方式运行它。

简而言之，这两张纸是＆＃34; Active＆＃34;和＆＃34;术语＆＃34;如果员工是否对公司有效。当我运行宏来请求输入员工ID时，我试图弹出一个弹出窗口。输入后，我想在A列中找到该唯一ID，然后在该行中选择一部分单元格（单元格A到G）（唯一值），然后将其剪切并粘贴到＆＃34中的下一个空行中术语＆＃34;片。完成后，我想从活动工作表中删除整行。

我已经使用嵌套在索引函数中的匹配函数来引用唯一值并从工作表和其他人返回数据，但我无法弄清楚这些是否会以某种方式帮助以及如何实现它们。我要的可能是不可能的。我可以录制一个宏，但值是静态的，只能在一个确切的时间内工作。提前谢谢。

Sub EmployeeTermination()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String
    Dim fVal As String
    Dim fRange As Range


    Set wssource = Worksheets("Active")
    Set wstarget = Worksheets("Term")

    iCol = 1
    MaxRowList = wssource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wssource.Cells()
        If S = "Yes" Or S = "yes" Then

            fVal = InputBox(Enter employee ID:)

            Set fRange = wstarget.Columns("A:A").Find(What:=fVal, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

            If fRange Is Nothing Then

                AfterLastTarget = wstarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

                wssource.Rows(x).Copy
                wstarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If

        End If
    Next

   Application.ScreenUpdating = True

End Sub

Answer 1

我知道这基本上改写了您的代码，但我添加了一些检查以确保您要删除您的员工。我假设员工的名字在B栏中，所以如果没有，你可以改变这一行：

If MsgBox("Are you sure you want to terminate " & wsActive.Cells(rngEmployee.Row, _
                2) & "?", vbYesNo) Then

将第二行中的2替换为您想要的任何列号。（或者您可以完全删除此检查。）

我还添加了最小的错误处理。

Option Explicit

Const Err_EmpNotFound = 1000

Public Function NextRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1) As Long
    With ws
        NextRow = .Cells(.Rows.Count, col).End(xlUp).Row + 1
    End With
End Function

Sub EmployeeTermination()
    'On Error GoTo ErrHandler

    Dim wsActive As Worksheet, wsTerm As Worksheet
    Set wsActive = ThisWorkbook.Worksheets("Active")
    Set wsTerm = ThisWorkbook.Worksheets("Term")

    'Locate the employee
    Dim rngEmployee As Range, sEmployeeID As String, empDataArr As Variant
    sEmployeeID = Application.InputBox("Enter Employee ID")
    Set rngEmployee = wsActive.Range("A:A").Find(sEmployeeID, Lookat:=xlWhole)
    If rngEmployee Is Nothing Then
        Err.Raise vbObjectError + Err_EmpNotFound, Description:="Employee Not Found"
    End If

    'Prompt before termination (assume's employee's name is column 2 (col B)
    If MsgBox("Are you sure you want to terminate " & wsActive.Cells(rngEmployee.Row, _
            2) & "?", vbYesNo) = vbNo Then
        Exit Sub
    End If
    empDataArr = rngEmployee.Columns("A:G").Value

    'Delete the data
    rngEmployee.EntireRow.Delete

    'Add employee to termination sheet (and date column "H")
    With wsTerm.Rows(NextRow(wsTerm))
        .Columns("A:G") = empDataArr
        .Columns("H") = Date
    End With

    'Notify user of completion
    MsgBox "Employee was successfully terminated!"
    Exit Sub

ErrHandler:
    Dim errBox As Long
    Select Case Err.Number - vbObjectError
        Case Err_EmpNotFound
            errBox = MsgBox(Err.Description, vbRetryCancel)
            If errBox = vbRetry Then
                Err.Clear
                EmployeeTermination
                End
            End If
        Case Else
            MsgBox Err.Description, Title:=Err.Number
    End Select
End Sub

复制由ID标识的部分行

1 个答案: