Question

我试图将以下代码限制为仅第6列和第7列，但它适用于整个工作表。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim lOld As Long

    If Target.Count > 1 Then GoTo exitHandler 

    On Error Resume Next

    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

    On Error GoTo exitHandler 

    If rngDV Is Nothing Then GoTo exitHandler    

    If Intersect(Target, rngDV) Is Nothing Then

       'do nothing

    Else

      Application.EnableEvents = False

      newVal = Target.Value

      Application.Undo

      oldVal = Target.Value

      Target.Value = newVal

      If Target.Column = 6 _
          Or Target.Column = 7 Then
        If oldVal = "" Then
          'do nothing
        Else
          If newVal = "" Then
            'do nothing
          Else
            lOld = Len(oldVal)
            If Left(newVal, lOld) = oldVal Then
              Target.Value = newVal
            Else
               Target.Value = oldVal _
                    & ", " & newVal
            End If
          End If
        End If
      End If
    End If

    If newVal = "" Then
      'do nothing
    Else

    lOld = Len(oldVal)

    If Left(newVal, lOld) = oldVal Then
        Target.Value = newVal
    Else
        Target.Value = oldVal _
          & ", " & newVal
    End If

    End If
exitHandler:

  Application.EnableEvents = True

End Sub

Answer 1

您在INTERSECT的测试中和以后的测试中都重复了代码。外面有一些针对列的测试，所以我不确定为什么它会触发……似乎还存在一个额外的End If我无法弄清楚，所以我不确定它的执行情况

我已经重写了删除多余的嵌套If和诸如此类的东西。我添加评论的主要目的是在我重写时帮助我，但它们可能对将来的编辑很有用。

此代码仅对第6列和第7列中类型为xlCellTypeAllValidation的单元格运行。如果您不需要仅限制xlCellTypeAllValidation个单元格，则将其从主If中删除测试。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim lOld As Long

    'Exit routine if more than one cell was changed
    If Target.Count > 1 Then GoTo exitHandler 

    'Shut off errors, and attempt to grab xlCellTypeAllValidation cells
    'If no cells are of type xlCellTypeAllValidation then exit routine
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    If rngDV Is Nothing Then GoTo exitHandler    

    'If the cell changed is xlCellTypeAllValidation AND in columns 6 or 7 Then run code
    If Not Intersect(Target, rngDV) Is Nothing AND (Target.Column = 6 OR Target.Column = 7) Then

        'Shut off events
        Application.EnableEvents = False

        'Capture old and new values to variables
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value

        'undo the undo
        Target.Value = newVal

        'If the cell used to hold a value and it was changed to a new value (not null)
        If oldVal <> "" AND newVal <> "" Then       

            'Test to see if the change didn't affect the contents of the cell
            lOld = Len(oldVal)
            If Left(newVal, lOld) = oldVal Then
                Target.Value = newVal
            Else 'They've truly changed the content, so bring in the old content and append the new with a comma
                Target.Value = oldVal & ", " & newVal
            End If
        
        End If      
    End If

exitHandler:
    Application.EnableEvents = True
End Sub

VBA代码不限于指定的列

1 个答案: