Question

我希望将工作簿用户的单元格范围限制为 (Example: A5:A30) 。

换句话说，将 A5:A30 范围内的字符总数限制为1000个字符。

当用户填写一个发送范围超过1000个字符限制的单元格时，它将调用Application.undo，它应该删除他们添加的最后一个文本。

但是，由于我在工作表上还有另一个 Private Sub Worksheet_Change(ByVal Targe As Range) ，因此会导致错误。

下面是两个Worksheet_Change子项。两者都使用相同的单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim charCount As Long

    If Not Intersect(Target, Range("E6,E11,E16")) Is Nothing Then

        Dim arrValues As Variant
        arrValues = Range("E6,E11,E16").Value2

        Dim i As Long
        Dim tempSplit As Variant
        Dim j As Long

            For i = LBound(arrValues) To UBound(arrValues)
             tempSplit = Split(arrValues(i, 1), " ")

            For j = LBound(tempSplit) To UBound(tempSplit)
                charCount = charCount + Len(tempSplit(j))
            Next j
        Next i

    End If

If charCount > 1000 Then
   Application.Undo
    MsgBox "Adding this exceeds the 1000 character limit"
 End If


            If Not Intersect(Target, Range("D6")) Is Nothing Then

        If Target.Value2 = "Material" Then
        'assumes the comment cell is one column to the right
            Target.Offset(0, 1) = "**"
        End If

    End If

            If Not Intersect(Target, Range("D7")) Is Nothing Then

        If Target.Value2 = "Material" Then
        'assumes the comment cell is one column to the right
            Target.Offset(-1, 1) = "**"
        End If

        End If

       If Not Intersect(Target, Range("D8")) Is Nothing Then

        If Target.Value2 = "Material" Then
           Target.Offset(-2, 1) = "**"
        End If

    End If
End Sub

有没有解决的办法，所以我可以在同一工作表上有两个 Worksheet_Change ？

Answer 1

一张纸中不能有两个Worksheeet_Change事件。但是，一个就足够了：

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case True
    Case Not Intersect(ActiveCell, Range("A5:A30")) Is Nothing
        DoThingOne
    Case Not Intersect(ActiveCell, Range("B5:B30")) Is Nothing
        DoThingTwo
    End Select

End Sub

Private Sub DoThingOne()
    Debug.Print "THING ONE"
End Sub

Private Sub DoThingTwo()
    Debug.Print "THING TWO"
End Sub

Answer 2

如何使用Vityata的想法进行修订？

Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case True

        Case Not Intersect(Target, Range("E6,E11,E16")) Is Nothing

            Dim charCount As Long

            Dim arrValues As Variant
            arrValues = Range("E6,E11,E16").Value2

            Dim i As Long
            Dim tempSplit As Variant
            Dim j As Long

            For i = LBound(arrValues) To UBound(arrValues)
                tempSplit = Split(arrValues(i, 1), " ")

                For j = LBound(tempSplit) To UBound(tempSplit)
                    charCount = charCount + Len(tempSplit(j))
                Next j
            Next i

            If charCount > 1000 Then
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With

                MsgBox "Adding this exceeds the 1000 character limit"
            End If

        Case Not Intersect(Target, Range("D6")) Is Nothing

            If Target.Value2 = "Material" Then
                'assumes the comment cell is one column to the right
                Target.Offset(0, 1) = "**"
            End If

        Case Not Intersect(Target, Range("D7")) Is Nothing

            If Target.Value2 = "Material" Then
                'assumes the comment cell is one column to the right
                Target.Offset(-1, 1) = "**"
            End If

        Case Not Intersect(Target, Range("D8")) Is Nothing

            If Target.Value2 = "Material" Then
                Target.Offset(-2, 1) = "**"
            End If

    End Select

End Sub

工作表中有多个工作表_Change

2 个答案: