EXCEL VBA，更改单元格组和 Worksheet_Change 事件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16134069/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
EXCEL VBA, Changes groups of cells and Worksheet_Change event
提问by Finch042
I suspect this isn't all that complicated, but I'm not having much luck finding the right terms to Google... so I came to the experts!
我怀疑这并没有那么复杂，但我没有多少运气找到合适的 Google 条款......所以我来找专家！
So I'm trying to implement an Worksheet_Changeevent. It's exceedingly simple, I basically just want to do the following:
所以我正在尝试实施一个Worksheet_Change事件。这非常简单，我基本上只想做以下事情：
If Value in Column C changes, and Value in D (in that row) has a specific formatting (NumberFormat = "$ 0.00") then Column E (in that row) is the product of those two values. Easy. Practically speaking, I just want the VBA equivalent of using a formula in the E column. This the code I'm using:
如果 C 列中的值发生变化，并且 D 中的值（在该行中）具有特定格式（NumberFormat = "$ 0.00"），则 E 列（在该行中）是这两个值的乘积。简单。实际上，我只想要在 E 列中使用公式的 VBA 等效项。这是我正在使用的代码：
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
My problem is popping up when I try to paste in multiple values into multiple rows of the c column. i.e. I'm copying a column of data (> 1 row) into C and I get a type mismatch error. I'll make the gigantic leap that it's not dealing with this well because "target" is intended to be a single cell as opposed to a group. I'm hoping there's a simple way to deal with this that doesn't involve some crazy loop every time a cell changes on the sheet or something.
当我尝试将多个值粘贴到 c 列的多行中时，我的问题出现了。即我正在将一列数据（> 1 行）复制到 C 中，但出现类型不匹配错误。我将做出巨大的飞跃，因为它没有很好地处理这个问题，因为“目标”旨在成为一个单元格而不是一个组。我希望有一种简单的方法来解决这个问题，每次表格上的单元格更改时都不会涉及一些疯狂的循环。
Thanks in advance!
提前致谢！
采纳答案by Siddharth Rout
Is this what you are trying?
这是你正在尝试的吗？
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
You might also want to read THIS?
您可能还想阅读这个？
Though you wanted to trap only Col C Paste but here is one more scenario where user pastes in multiple columns (One of them being Col C)
虽然您只想捕获 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
回答by Floris
In the spirit of completeness and collaboration, I am posting here a variation of Siddharth Rout's method; the difference is that this does not rely on "cells to act on" all being in one column. This makes it a little bit cleaner, and easier to adapt to other scenarios.
本着完整性和协作精神，我在这里发布了 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
