Excel 将工作表VBA转换为所有工作表
我试图将一些代码放在一张工作表上,并将其转换为适用于书中所有工作表的代码。我想我可以将代码移动到一个模块中,然后使用中描述的工作簿更改“包装器”。但是,尽管在所有图纸上定义了“命名范围”,但“多选”下拉列表仍仅适用于原始图纸Excel 将工作表VBA转换为所有工作表,excel,vba,module,Excel,Vba,Module,我试图将一些代码放在一张工作表上,并将其转换为适用于书中所有工作表的代码。我想我可以将代码移动到一个模块中,然后使用中描述的工作簿更改“包装器”。但是,尽管在所有图纸上定义了“命名范围”,但“多选”下拉列表仍仅适用于原始图纸 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Sh Dim OldVal As String Dim NewVal A
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Sh
Dim OldVal As String
Dim NewVal As String
' If more than 1 cell is being changed
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, ActiveSheet.Range("Named_Range")) Is Nothing Then
' Turn off events so our changes don't trigger this event again
Application.EnableEvents = False
NewVal = Target.Value
' If there's nothing to undo this will cause an error
On Error Resume Next
Application.Undo
On Error GoTo 0
OldVal = Target.Value
' If selection is already in the cell we want to remove it
If InStr(OldVal, NewVal) Then
'If there's a comma in the cell, there's more than one word in the cell
If InStr(OldVal, ",") Then
If InStr(OldVal, ", " & NewVal) Then
Target.Value = Replace(OldVal, ", " & NewVal, "")
Else
Target.Value = Replace(OldVal, NewVal & ", ", "")
End If
Else
' If we get to here the selection was the only thing in the cell
Target.Value = ""
End If
Else
If OldVal = "" Then
Target.Value = NewVal
Else
' Delete cell contents
If NewVal = "" Then
Target.Value = ""
Else
' This IF prevents the same value appearing in the cell multiple times
' If you are happy to have the same value multiple times remove this IF
If InStr(Target.Value, NewVal) = 0 Then
Target.Value = OldVal & ", " & NewVal
End If
End If
End If
End If
Application.EnableEvents = True
Else
Exit Sub
End If
End With
End Sub
常规模块没有事件。他们是主机不可知论者。事件位于工作簿对象中。因此,这意味着您必须将代码放入
ThisWorkBook
对象中
现在看看你的代码,我看到一个带有Sh的块,它什么都不做。你从来不用那个东西。使用图纸对象唯一有意义的地方是引用ActiveSheet
的地方。我们总是希望使用Sh
,我们从不希望假设正确的工作表处于活动状态
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim OldVal As String
Dim NewVal As String
' If more than 1 cell is being changed
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Sh.Range("Named_Range")) Is Nothing Then
' Turn off events so our changes don't trigger this event again
Application.EnableEvents = False
NewVal = Target.Value
' If there's nothing to undo this will cause an error
On Error Resume Next
Application.Undo
On Error GoTo 0
OldVal = Target.Value
' If selection is already in the cell we want to remove it
If InStr(OldVal, NewVal) Then
'If there's a comma in the cell, there's more than one word in the cell
If InStr(OldVal, ",") Then
If InStr(OldVal, ", " & NewVal) Then
Target.Value = Replace(OldVal, ", " & NewVal, "")
Else
Target.Value = Replace(OldVal, NewVal & ", ", "")
End If
Else
' If we get to here the selection was the only thing in the cell
Target.Value = ""
End If
Else
If OldVal = "" Then
Target.Value = NewVal
Else
' Delete cell contents
If NewVal = "" Then
Target.Value = NewVal
Else
' This IF prevents the same value appearing in the cell multiple times
' If you are happy to have the same value multiple times remove this IF
If InStr(Target.Value, NewVal) = 0 Then
Target.Value = OldVal & ", " & NewVal
End If
End If
End If
End If
Application.EnableEvents = True
Else
Exit Sub
End If
End Sub
最后,在if
树的底部有一个逻辑缺陷。如果oldval不在newval中,oldval也不为空,而newval也不为空,那么最后一个位置将添加逗号。如果不需要该更改,则您处于这样一种状态:对更改运行了.Undo
,并且根本没有设置Target.Value
。这可能会使您无法将单元格内容更改为新值。我不确定你是否有意这样做。解决了我的主要问题。我相信逻辑上的缺陷是无意中存在的。我需要仔细考虑如何解决它。