Question

我怀疑这并不是那么复杂，但我没有太多运气找到合适的条款给谷歌......所以我来找专家！

所以我正在尝试实施Worksheet_Change事件。这非常简单，我基本上只想做以下事情：

如果C列中的值发生更改，并且D中的值（在该行中）具有特定格式（NumberFormat =“$ 0.00”），则列E（在该行中）是这两个值的乘积。简单。实际上，我只想要VBA相当于在E列中使用公式。这是我正在使用的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 And Target.Value <> "" Then
    If Target.Offset(0, 1).NumberFormat = "$ 0.00" Then
        Target.Offset(0, 2).Value = Target.Value * Target.Offset(0, 1).Value
        End If
        End If   
end sub

当我尝试将多个值粘贴到c列的多行时，我的问题就出现了。即我正在将一列数据（> 1行）复制到C中，我得到一个类型不匹配错误。我会做出巨大的飞跃，因为“目标”是一个单一的细胞，而不是一个群体。我希望有一种简单的方法可以解决这个问题，每次细胞更换片材或其他东西时都不会涉及一些疯狂的循环。

提前致谢！

Answer 1

这是你在尝试的吗？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each aCell In Target
            If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
            End If
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

您可能还想阅读THIS？

虽然您只想捕获Col C Paste，但是这里还有一个用户在多个列中粘贴的方案（其中一个是Col C）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False


    If Not Intersect(Target, Columns(3)) Is Nothing Then
        If Not Target.Columns.Count > 1 Then
            For Each aCell In Target
                If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
                    aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
                End If
            Next
        Else
            MsgBox "Please paste in 1 Column"
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Answer 2

本着完整性和协作的精神，我在这里发布了Siddharth Rout方法的变体;不同之处在于，这并不依赖于“细胞作用于”所有在一列中。这使它更清洁，更容易适应其他场景。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim onlyThese As Range   ' collection of ranges that, if changed, trigger some action
    Dim cellsToUse As Range  ' cells that are both in "Target" and in "onlyThese"

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set onlyThese = Range("C:C") ' in this instance, but could be anything - even a union of ranges
    Set cellsToUse = Intersect(onlyThese, Target)
    If cellsToUse Is Nothing Then GoTo Letscontinue

    ' loop over cells that were changed, and of interest:
    For Each aCell In cellsToUse
        If aCell.Value <> "" And aCell.Offset(0, 1).NumberFormat = "$ 0.00" Then
            aCell.Offset(0, 2).Value = aCell.Value * aCell.Offset(0, 1).Value
        End If
    Next

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

EXCEL VBA，更改单元格组和Worksheet_Change事件

2 个答案: