여러 개의 셀을 동시에 삭제할 때 런타임 오류가 발생합니다 13

Question

하나의 셀만 선택하고 삭제할 때 다음 코드가 제대로 작동하지만 여러 셀을 선택하면 런타임 오류 13 "유형 불일치가 발생합니다 ":

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim sheetName As String 
    Dim sheetCodeName As String 
    Dim cel As Range 

    If Target.Column = "12" Then 
    On Error GoTo DELETESTUFF 
     sheetName = Target.Value 
    On Error GoTo 0 
     sheetCodeName = Target.Offset(0, -2).Value 

     For Each Sheet In ActiveWorkbook.Worksheets 
      If Sheet.CodeName = sheetCodeName Then 
      If sheetName = "" Then 
       On Error GoTo INVALIDCOLUMNNAME: 
      End If 
       On Error GoTo INVALIDCOLUMNNAME: 
       Sheet.Name = sheetName 
       On Error GoTo 0 

      End If 

     Next Sheet 

    End If 

Exit Sub 

INVALIDCOLUMNNAME: 

If Target.Column = "12" Then 
    sheetName = Target.Offset(0, -1).Value 
    sheetCodeName = Target.Offset(0, -2).Value 

    For Each Sheet In ActiveWorkbook.Worksheets 
     If Sheet.CodeName = sheetCodeName Then 

      On Error GoTo INVALIDCO: 
      Sheet.Name = sheetName 
      On Error GoTo 0 

     End If 

    Next Sheet 

End If 

Exit Sub 

DELETESTUFF: 

If Not Intersect(Target, Columns(12)) Is Nothing Then 
    On Error GoTo INVALIDCO 
    Application.EnableEvents = False 
    For Each cel In Intersect(Target, Columns(12)) 
     sheetName = cel.Offset(0, -1).Value 
     sheetCodeName = cel.Offset(0, -2).Value 
     For Each Sheet In ThisWorkbook.Worksheets 
      If Sheet.CodeName = sheetCodeName Then 
       Sheet.Name = sheetName 
       Exit For 'no need to continue 
      End If 
     Next Sheet 
    Next cel 
End If 

Exit Sub 

INVALIDCO: 
Application.EnableEvents = True 

아무도 도와 줄 수 있습니까?

미리

에 감사

Answer 1

Target 및 의 사용은 "삭제"이이 Worksheet_Change 이벤트 매크로 것을 알려줍니다. 이 경우 Target은 셀 하나가 아닌 셀 범위를 나타낼 수 있습니다. 일치하는 각 셀을 통과하고 각 셀과 관련된대로 작업을 수행하려면 For Each ... In Intersect(Target, Columns(12)이 필요합니다. 즉

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Columns(12)) Is Nothing Then 
     On Error GoTo INVALIDCO 
     Application.EnableEvents = True 
     Dim cel As Range, sheetName As String, sheetCodeName As String, ws As Worksheet 
     For Each cel In Intersect(Target, Columns(12)) 
      sheetName = cel.Offset(0, -1).Value 
      sheetCodeName = cel.Offset(0, -2).Value 
      For Each ws In ThisWorkbook.Worksheets 
       If ws.CodeName = sheetCodeName Then 
        If IsEmpty(cel) Then 
         ws.Name = Right("0" & Replace(ws.CodeName, "sheet", vbNullString, 1, 1, vbTextCompare), 2) 
        ElseIf CBool(Len(sheetName)) Then 
         'addition worksheet name validation here 
         ws.Name = sheetName 
        Else 
         'do nothing. blank worksheet name 
        End If 
        Exit For 
       End If 
      Next ws 
     Next cel 
    End If 
INVALIDCO: 
    Application.EnableEvents = True 
End Sub 

, 당신은 L2 선택한 경우 : L5 당신은 K2 할당 할 수 없습니다 : L5를하고 탭 이 삭제 후 Target은 L2와 동일 원래 코드에서 SHEETNAME에 당신이 가지고있는 방법을 K5를 . 이 값을 여러 값으로 사용할 계획이라면 L 열의 삭제 된 값마다 J 및 K 열에 적절한 값이 있는지 확인하기 위해 추가 오류 제어를 추가해야합니다.