时间戳

首页 > 解决方案 > VBA 代码不限于指定列

vba - VBA 代码不限于指定列

问题描述

我试图将以下代码限制为仅第 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

标签： vbaexcel

解决方案

您已经在测试内部INTERSECT和之后在该测试之外复制了代码。外面的列有一些测试，所以我不确定它为什么会触发......似乎还有一个额外的End If我无法弄清楚，所以我不确定它是如何执行的。

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

此代码仅针对xlCellTypeAllValidation第 6 列和第 7 列中的类型的单元格运行。如果您不需要仅限于单元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

推荐阅读