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

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

我的假设

工作簿中有5张表; Sheet1，Sheet2，Sheet3，Sheet4和Sheet5
更改Sheet5中的单元格时，根据更改的单元格，Sheets1-4's名称已更改
我假设当A1更改时，Sheet1会重命名。 A2更改后，Sheet2会重命名，依此类推......

<强>逻辑

使用Worksheet_Change事件来捕获对单元格A1，A2，A3或A4
使用Sheet CodeName更改名称
检查工作表名称是否有效。工作表名称不能包含任何这些字符\ / * ? [ ]
检查您是否已有一张包含您要用于重命名的名称的工作表
如果一切都是笨拙的，那么请继续并替换

<强>代码

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

<强>截图

enter image description here

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

1 个答案: