Question

如果将值添加到特定范围，我想创建一个向第一列添加特定值的代码。如果该范围为空，则删除该值。这是我到目前为止所做的，但我一直在犯错误，而且我似乎无法弄清楚我做错了什么。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, cell As Range

On Error GoTo haveError

Set rng = Application.Intersect(Target, Me.Range("B1:G100"))

If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell In rng.Cells
    If cell.Value = "blah" Then
        Range("A" & cell.Row).Value = "derp"
    End If
    Next
For Each cell In rng.Cells
    If Range("B" & cell.Row, "G" & cell.Row).Value = "" Then
        Range("A" & cell.Row).ClearContents
    End If
    Next
Application.EnableEvents = True

End If
Exit Sub

haveError:
MsgBox Err.Description
Application.EnableEvents = True

End Sub

Answer 1

此行中出现错误语法时出现Type mismatch错误：

If Range("B" & cell.Row, "G" & cell.Row).Value = "" Then

所以，我修改了它并且运行良好。我还减少了一个循环，因为两个条件只能在一个循环中设置。

这里是完整的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, cell As Range

    On Error GoTo haveError

    Set rng = Application.Intersect(Target, Me.Range("B1:G100"))

    If Not rng Is Nothing Then

        Application.EnableEvents = False

        For Each cell In rng.Cells

            If cell.Value = "blah" Then
                Me.Range("A" & cell.Row).Value = "derp"
            End If

            If WorksheetFunction.CountA(Me.Range("B" & cell.Row & ":" & "G" & cell.Row)) = 0 Then
                Me.Range("A" & cell.Row).ClearContents
            End If

        Next

        Application.EnableEvents = True

    End If

    Exit Sub

haveError:
    MsgBox Err.Description
    Application.EnableEvents = True

End Sub

Answer 2

我重新组织了一些命令，只在必要时执行了操作。

Private Sub Worksheet_Change(ByVal Target As Range)

    'don't do anything unless there is something to do
    If Not Intersect(Target, Me.Range("B1:G100")) Is Nothing Then
        On Error GoTo haveError
        'don't declare vars until you kow you will need them
        Dim rng As Range, cell As Range
        Application.EnableEvents = False

        Set rng = Application.Intersect(Target, Me.Range("B1:G100"))
        For Each cell In rng.Cells
            If cell.Value = "blah" Then
                Range("A" & cell.Row).Value = "derp"
            ElseIf Application.CountBlank(Cells(cell.Row, "B").Resize(1, 6)) = 6 Then
                Cells(cell.Row, "A").ClearContents
            End If
    End If
    GoTo safeExit

haveError:
    If CBool(Err.Number) Then
        'Debug.Print Err.Number & ": " & Err.Description
        MsgBox Err.Number & ": " & Err.Description
        Err.Clear
    End If
safeExit:
    Set rng = Nothing
    Application.EnableEvents = True

End Sub

我没有使用For Each...Next Statement，而是使用If ... ElseIf ... End If，因为条件是互斥的（即如果一个是真的，另一个则不是真的）。

如果更改某个范围中的某个单元格，则输入一个单元格值;如果范围为空，则删除它

2 个答案: