하나의 워크 시트에서 문자열을 찾고 다른 워크 시트에서 일치하는 문자열을 삭제하십시오.

Question

각 팀 구성원에 대해 수행해야하는 작업에 대해 Excel 시트를 설정하고 있습니다. 실행해야하는 모든 작업이 포함 된 시트 ("마스터 작업 목록")가 있습니다. C 열에는 작업에 대한 설명이 표시됩니다. D 열에 책임자가 표시됩니다. 작업이 사람에게 할당되면 해당 작업이 해당 사람의 시트에 자동으로 복사됩니다.

이 부분 코드는 나를 위해 작동합니다.

내가 찾고있는 것은 개인 작업 시트에서 작업이 삭제 될 작업 (K 열은 100 %)이 완료되었을 때입니다. 이 내가 지금까지 작성한 코드입니다 : 나는 그것이 사람 시트에 마스터 작업 목록에 행을 삭제하고 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 

.

미리 감사드립니다.

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를 해제하는 것이 좋습니다.