基于依赖单元格的动态工作表名称

Question

抱歉，如果这很简单，但我是 VBA 新手。我正在尝试设置我的 Excel 工作表，以便在更改第一张工作表中的某些单元格（例如 A1、A2、A3、A4）时，其他四个工作表的名称将更改以匹配它们。如果我更改该工作表上的特定单元格，我发现以下公式有效；

`

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        Set Target = Range("A1")
        If Target = "" Then Exit Sub
        On Error GoTo Badname
        ActiveSheet.Name = Left(Target, 31)
        Exit Sub
    Badname:
        MsgBox "Please revise the entry in A1." & Chr(13) _
        & "It appears to contain one or more " & Chr(13) _
        & "illegal characters." & Chr(13)
        Range("A1").Activate
    End Sub

` 不幸的是，如果我将 A1 更改为依赖于先前指定的主工作表上的四个单元格之一，它将不起作用，因为它只查找保存它的工作表中的更改。

有没有办法使用 VBA 查看一个工作表中的单元格，然后更改另一个工作表的工作表名称以匹配？

谢谢

Answer 1

就像我在 cmets 中提到的那样，重命名工作表并不是那么简单。你必须检查很多东西。

我的假设

1. 您的工作簿中有 5 张工作表； Sheet1、Sheet2、Sheet3、Sheet4 和 Sheet5
2. 当您更改Sheet5 中的单元格时，根据更改的单元格，Sheets1-4's 名称会更改
3. 我假设当A1 更改时，Sheet1 被重命名。当A2 改变时，Sheet2 被重命名等等......

逻辑

1. 使用Worksheet_Change 事件捕获对单元格A1、A2、A3 或A4 的更改
2. 使用 Sheet CodeName 更改名称
3. 检查工作表名称是否有效。工作表名称不能包含以下任何字符\ / * ? [ ]
4. 检查您是否已经有一张带有您要用于重命名的名称的工作表
5. 如果一切都很好，那就去替换

代码

请参阅此示例。此代码位于Sheet5 代码区。

Dim sMsg As String

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsName As String

    On Error GoTo Whoa

    sMsg = "Success"

    Application.EnableEvents = False

    If Not Target.Cells.CountLarge > 1 Then
        If Not Intersect(Target, Range("A1")) Is Nothing Then
            wsName = Left(Target, 31)

            RenameSheet [Sheet1], wsName
        ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then
            wsName = Left(Target, 31)

            RenameSheet [Sheet2], wsName
        ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then
            wsName = Left(Target, 31)

            RenameSheet [Sheet3], wsName
        ElseIf Not Intersect(Target, Range("A4")) Is Nothing Then
            wsName = Left(Target, 31)

            RenameSheet [Sheet4], wsName
        End If
    End If

    MsgBox sMsg
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

'~~> Procedure actually renames the sheet
Sub RenameSheet(ws As Worksheet, sName As String)
    If IsNameValid(sName) Then
        If sheetExists(sName) = False Then
            ws.Name = sName
        Else
            sMsg = "Sheet Name already exists. Please check the data"
        End If
    Else
        sMsg = "Invalid sheet name"
    End If
End Sub

'~~> Check if sheet name is valid
Function IsNameValid(sWsn As String) As Boolean
    IsNameValid = True

    '~~> A sheet name cannot contain any of these Characters \ / * ? [ ]
    For i = 1 To Len(sWsn)
        Select Case Mid(sWsn, i, 1)
        Case "\", "/", "*", "?", "[", "]"
            IsNameValid = False
            Exit For
        End Select
    Next
End Function

'~~> Check if the sheet exists
Function sheetExists(sWsn As String) As Boolean
    Dim ws As Worksheet

    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sWsn)
    On Error GoTo 0

    If Not ws Is Nothing Then sheetExists = True
End Function

截图