是否可以将excel中的VBA函数分配给始终绑定到范围?

Question

我有简单的代码，每当"工资国家"单元格更改时，都会清除"州"单元格。 例如，如果用户在 A6 中选择"USA"，然后在 X6 中选择"亚利桑那州"，那么也许稍后由于某种原因他们改变了主意并想为国家/地区选择"CAN"，则州单元格将清除。

但是，如果将来有人决定在 X 列之前插入一列，它显然会将我的 State 列移过来。 有没有办法使 VBA 更智能(或让我更聪明)，以便将函数绑定到"状态"列而不是特定的"X"列？

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
'check Target column and row...
If Target.Column = 1 And Target.Row >= 6 Then
With Target.EntireRow

'State column
.Columns("X").Value = ""


End With
End If
End Sub

Answer 1

可以使用命名区域，也可以使用.Find来确定 State 列当前所在的位置。下面是一个使用.Find

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
'check Target column and row...
If Target.Column = 1 And Target.Row >= 6 Then
Dim StateCol As Long
StateCol = Me.Range("1:5").Find("State", LookIn:=xlValues, LookAt:=xlPart).Column

With Target.EntireRow

'State column
.Columns(StateCol).Value = ""


End With
End If
End Sub

如果要改用命名范围，则可以使用StateCol = Me.Range("NamedRange").Column定义StateCol，它会快一点，因为它不需要在用户每次更改值时搜索行。

旁注：.Find的搜索范围是第 1 行到第 5 行，但您可能希望根据预期的数据移动方式来限制或扩展该范围。

Answer 2

我(总是)为列定义一个枚举，如下所示

Public enum col_TableXXX    'adjust to your needs
col_ID = 1
col_PayrollCountry
col_State
end enum

枚举是自动编号的 - 因此col_PayrollCountry等于 2，col_State等于 3，依此类推。

如果有新列或顺序更改，您只需移动枚举或添加新枚举即可。

(您可以通过将列标题转置粘贴到 Excel 工作表上，然后通过公式创建代码来避免代码类型)

然后，您可以像这样使用枚举：

If target.column = col_PayrollCountry then
target.entireRow.columns(col_State) = vbnullstring
End If

这也比columns("X")更"可读"

此解决方案的罪魁祸首：您必须知道列已更改。它不是基于列名的自动性。

Answer 3

你的问题还有另一种解决方案(我受到与ACCtionMan关于枚举内容的简短讨论的影响)：

如果可以插入表(插入>表)，则可以使用listobject。在许多其他优点中，您可以按其名称引用该列。

我假设该表名为"tblData">

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject
Set lo = Me.ListObjects("tblData")
If Not Intersect(Target, lo.ListColumns("Payroll Country").DataBodyRange) Is Nothing Then
'changed cell is in Payroll country column then
'take the intersection of the targets row and the State column to change the value
Intersect(Target.EntireRow, lo.ListColumns("State").DataBodyRange) = vbNullString
End If
End Sub

但我更喜欢以下解决方案 - 因为我喜欢在事件处理程序中使用业务逻辑。

如果你的同事(甚至你6个月后)查看变更事件代码，他/她将立即了解这里发生了什么 - 而无需阅读它是如何完成的。

Option Explicit
Private m_loData As ListObject
Private Sub Worksheet_Change(ByVal target As Range)
'if target cells is not within loData we don't need to check the entry
If Intersect(target, loData.DataBodyRange) Is Nothing Then Exit Sub
If ColumnHeaderOfRange(target) = "Payroll Country" Then
resetStateColumnToEmptyValue target
End If
End Sub

Private Sub resetStateColumnToEmptyValue(c As Range)
Intersect(c.EntireRow, loData.ListColumns("State").DataBodyRange) = vbNullString
End Sub
'this could go in a general module - then add listobject as parameter
Private Function ColumnHeaderOfRange(c As Range) As String
On Error Resume Next ' in case c is outside of listobject
ColumnHeaderOfRange = Intersect(c.Cells(1, 1).EntireColumn, loData.HeaderRowRange)
On Error GoTo 0
End Function
'this could be public then you can access the table from outside the worksheet module
Private Function loData() As ListObject
If m_loData Is Nothing Then
Set m_loData = Me.ListObjects("tblData")
End If
Set loData = m_loData
End Function