Excel：根据另一个工作表上另一个单元格中的值更新工作表

Question

场景：单元格 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 似乎是问题所在，但我不知道将其设置为什么，因此它会粘在我要更改的工作表上。

Answer 1

您的代码在您所在的工作表的Change 事件上触发，如果该工作表上的目标不是"$B$5"，它会立即退出。当另一个工作表被更改时，它什么也不做。如果您将"$B$5" 设置为等于另一个工作表上的引用，则在您设置该引用时将触发该事件，但如果引用的单元格（'Internal Use'!B7）发生更改，您猜怎么着？即使您的引用单元格 ("$B$5") 似乎发生了变化以反映另一张纸上的变化，但它实际上并没有改变。公式仍然是='Internal Use'!B7，就像以前一样。因此，不会调用您的代码来更改另一个工作表。

您可以将代码移至标准模块，然后在两个工作表的事件中调用它。