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

Dynamic sheet names based on dependent cells

提问by user2790744

Apologies if this is simple, but I am new to VBA. I am attempting to set up the my Excel sheet so that when certain cells in the first sheet are changed (eg A1, A2, A3, A4) the names of four other sheets will change to match them. I have found the following formula which works if I change the specific cell on that sheet;

抱歉，如果这很简单，但我是 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

` Unfortunately it will not work if I change A1 to be dependent on one of the four cells on the main sheet specified previously, as it only looks for changes in the sheet it is saved in.

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

Is there a way to use VBA to look at a cell in one sheet and then change the sheet name of another sheet to match?

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

Thanks

谢谢

回答by Siddharth Rout

Like I mentioned in the comments, it's not that simple to rename the sheet. You have to check for so many things.

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

My Assumptions

我的假设

1. You have 5 Sheets in a workbook; Sheet1, Sheet2, Sheet3, Sheet4and Sheet5
2. When you change cells in Sheet5, depending on the cell which changes, Sheets1-4'snames are changed
3. I am assuming that when A1changes, Sheet1is renamed. When A2changes, Sheet2is renamed and so on...

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

Logic

逻辑

1. Use Worksheet_Changeevent to trap changes to cell A1, A2, A3or A4
2. Use Sheet CodeName to change the name
3. Check if the sheet name is valid. A sheet name cannot contain any of these Characters \ / * ? [ ]
4. Check if you already have a sheet with the name you want to use for renaming
5. If everything is hunky dory then go ahead and replace

1. 使用Worksheet_Change事件陷阱改变细胞A1，A2，A3或A4
2. 使用 Sheet CodeName 更改名称
3. 检查工作表名称是否有效。工作表名称不能包含任何这些字符\ / * ? [ ]
4. 检查您是否已经有一个带有要用于重命名的名称的工作表
5. 如果一切都很好，那么继续更换

Code

代码

See this example. This code goes in the Sheet5code area.

请参阅此示例。此代码位于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

Screenshot

截屏