Question

我为每个团队成员设置了需要执行的任务的Excel工作表。我有一张表（＆＃34;主任务列表＆＃34;），其中包含所有需要执行的任务。在C列中将是任务的描述。在D栏中将是负责人。将任务分配给某人时，该任务将自动复制到该人员的工作表中。

这部分代码对我有用。

我正在寻找的是当一项任务完成时（K栏将是100％），该任务将从人员个人表中删除。这是我到目前为止创建的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim nextrow1 As Long, nextrow2 As Long, nextrow3 As Long, nextrow4 As Long, nextrow5 As Long, nextrow6 As Long
    Dim i As Long, j As Long
    Dim w6 As Worksheet, w2 As Worksheet, w3 As Worksheet, w4 As Worksheet, w5 As Worksheet, w1 As Worksheet, wt As Worksheet
    Dim temp As String, c As Long, aCell As String, tempsheet As String

    Set w1 = Sheets("Master task list")
    Set w2 = Sheets("Name A")
    Set w3 = Sheets("Name B")
    Set w4 = Sheets("Name C")
    Set w5 = Sheets("Name D")
    Set w6 = Sheets("Reporting")



    nextrow1 = w1.Range("C" & w1.Rows.Count).End(xlUp).Row + 1
    nextrow2 = w2.Range("C" & w2.Rows.Count).End(xlUp).Row + 1
    nextrow3 = w3.Range("C" & w3.Rows.Count).End(xlUp).Row + 1
    nextrow4 = w4.Range("C" & w4.Rows.Count).End(xlUp).Row + 1
    nextrow5 = w5.Range("C" & w5.Rows.Count).End(xlUp).Row + 1
    nextrow6 = w6.Range("C" & w6.Rows.Count).End(xlUp).Row + 1


    If Target.Cells.Count > 1 Then Exit Sub

    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("K14:K" & Cells(Rows.Count, "K").End(xlUp).Row)) Is Nothing Then
        i = Target.Row
        If Target.Value = 1 Then
            tempsheet = Cells(i, "D").Value
            Set wt = Sheets(tempsheet)
            aCell = Cells(i, "C").Value
            Sheets(tempsheet).Activate
            Cells.Find(What:=aCell, LookIn:=xlValues, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).EntireRow.Delete

        End If
    End If

    If Target.Cells.Count > 1 Then Exit Sub
    Application.ScreenUpdating = False

    If Not Intersect(Target, Range("D14:D" & Cells(Rows.Count, "D").End(xlUp).Row)) Is Nothing Then
        j = Target.Row
        If Target.Value = "Name A" Then
            w1.Range(w1.Cells(j, "A"), w1.Cells(j, "ZA")).Copy w2.Range("A" & nextrow2)
        End If
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

当我将主任务列表上的值更改为100％时，它会删除主任务列表中的行而不会删除个人表上的行。

提前致谢

Answer 1

尝试将两个操作结合在一起的修改。我已经减少了声明和分配的变量，但这确实意味着更长的代码行。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Dim tr As Long

    tr = Target.Row
    If Not Intersect(Target, Range("K14:K" & Cells(Rows.Count, "K").End(xlUp).Row)) Is Nothing Then
        On Error GoTo Fallthrough
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        If Target.Value = 1 Then
            If Not IsError(Application.Match(Cells(tr, "C").Value, Sheets(Cells(tr, "D").Value).Columns("C"), 0)) Then
                Sheets(Cells(tr, "D").Value).Rows(Application.Match(Cells(tr, "C").Value, Sheets(Cells(tr, "D").Value).Columns("C"), 0)).EntireRow.Delete
            End If
        End If
    ElseIf Not Intersect(Target, Range("D14:D" & Cells(Rows.Count, "D").End(xlUp).Row)) Is Nothing Then
        tr = Target.Row
        Range(Cells(tr, "A"), Cells(tr, "ZA")).Copy Sheets(Cells(tr, "D").Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If

Fallthrough:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

关闭Application.EnableEvents始终是一个好习惯，因此事件驱动的宏不会尝试在其上运行。

在一个工作表中查找字符串并删除其他工作表中的匹配字符串

1 个答案: