方案：单元格B5具有上一个工作表中的参考公式（='内部使用'！B7），我们希望更新工作表名称以匹配单元格B5中的值。
以下代码在直接输入到B5的值时起作用，但在它是对另一个工作表的引用时则不起作用：
Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If Target.Address <> "$B$5" Then Exit Sub
'If the target cell is empty (contents cleared) do not change the sheet name.
If IsEmpty(Target) Then Exit Sub
'Disallow the entry if it is greater than 31 characters.
If Len(Target.Value) > 31 Then
MsgBox "Worksheet names cannot be more than 31 characters." & vbCrLf & _
Target.Value & " has " & Len(Target.Value) & " characters.", _
48, "Keep it under 31 characters."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & _
"Enter a name without the ''" & IllegalCharacter(i) & "'' character.", _
48, "Not a possible sheet name !!"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
Next i
'Verify that the proposed sheet name does not already exist in the workbook.
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = Trim(Target.Value)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If
'If the worksheet name does not already exist, name the sheet as cell value.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If bln = False Then
ActiveSheet.Name = strSheetName
Else
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
我对VBA很新，所以我可能会使用完全错误的编码。
简而言之，我们希望发生什么，每当内部使用表单上的单元格更新时，相应的工作表名称都会跟随套件。
感谢。
更新：我尝试的另一个选项是计算事件。该代码有效，除了它改变了我当前的工作表，我不想要。我希望它能改变另一个工作表的名称，而不是活动名称。
Private Sub Worksheet_Calculate()
With Range("B5")
If Len(.Value) = 0 Or Len(.Value) > 31 Then Exit Sub
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(.Text, (IllegalCharacter(i))) > 0 Then
MsgBox "The formula in cell A1 returns a value containing a character that violates sheet naming rules." & vbCrLf & _
"Recalculate the formula without the ''" & IllegalCharacter(i) & "'' character.", _
48, "Not a possible sheet name !!"
Exit Sub
End If
Next i
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = (.Text)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If
If bln = False Then
ActiveSheet.Name = strSheetName
ElseIf ActiveSheet.Name <> .Text Then
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Recalculate the formula in cell A1 to return a unique name."
End If
End With
End Sub
ActiveSheet.Name似乎是个问题，但我不知道该将它设置为什么，因此它会粘贴到我想要更改的工作表上。
答案 0 :(得分：0)
您的代码会针对您所使用的工作表的Change事件触发，如果该工作表上的目标不是"$B$5"，则会立即退出。当另一个工作表被更改时，它什么都不做。如果将"$B$5"设置为等于另一个工作表上的引用，则在设置该引用时将触发该事件，但如果引用的单元格（'Internal Use'!B7）发生更改，请猜猜是什么？即使您的引用单元格（"$B$5"）似乎更改以反映另一个工作表上的更改，但它实际上并未更改。公式仍然是='Internal Use'!B7，就像以前一样。因此，您的代码不会被调用以在另一个工作表上进行更改。
您可以做的是将代码移动到标准模块，然后在两个工作表的事件中调用它。