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

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

这部分代码正在为我工​​作。

我正在寻找的是一个任务完成（列K将是100％）任务将被删除的人的个人表。 这是我迄今为止创build的代码：

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

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

 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 

closuresApplication.EnableEvents总是一个很好的习惯，所以事件驱动的macros将不会尝试在它自己之上运行。