使用VBA中同一工作表的单元格值重命名Excel中的多个工作表

我目前正在从事一个VBA项目，我有一个工作簿，其中包含来自不同工作簿的多个选项卡。所有选项卡的名称都是相同的，但是因为它们来自不同的文件，所以我想根据提取它们的文件名来命名它们。文件名显示在每个选项卡的单元格EC1中。我想根据每个工作表的单元格EC1中的值命名工作簿中的所有工作表

我使用了许多代码，但是以下代码：

Sub RenameSheet()

Dim rs As Worksheet

For Each rs In Sheets
rs.Name = rs.Range("EC1")
Next rs

End Sub

然而，我得到了一个1004以上的代码错误

我也试过这个代码：

Sub RenameSheet()
Dim xWs As Worksheet
Dim xRngAddress As String
Dim xName As String
Dim xSSh As Worksheet
Dim xInt As Integer
xRngAddress = Application.ActiveCell.Address
On Error Resume Next
Application.ScreenUpdating = False
For Each xWs In Application.ActiveWorkbook.Sheets
    xName = xWs.Range(xRngAddress).Value
    If xName <> "" Then
        xInt = 0
        Set xSSh = Nothing
        Set xSSh = Worksheets(xName)
        While Not (xSSh Is Nothing)
            Set xSSh = Nothing
            Set xSSh = Worksheets(xName & "(" & xInt & ")")
            xInt = xInt + 1
        Wend
        If xInt = 0 Then
            xWs.Name = xName
        Else
            If xWs.Name <> xName Then
                xWs.Name = xName & "(" & xInt & ")"
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
End Sub

Sub-RenameSheet（）
将xWs设置为工作表
朦胧的花束
将xName设置为字符串
将xSSh设置为工作表
Dim xInt作为整数
xRngAddress=Application.ActiveCell.Address
出错时继续下一步
Application.ScreenUpdating=False
对于Application.ActiveWorkbook.Sheets中的每个xWs
xName=xWs.Range（xRngAddress）.Value
如果xName为“”，则
xInt=0
设置xSSh=Nothing
Set xSSh=工作表（xName）
而不是（xSSh什么都不是）
设置xSSh=Nothing
设置xSSh=工作表（xName&“（&xInt&”）
xInt=xInt+1
温德
如果xInt=0，则
xWs.Name=xName
其他的
如果是xWs.Name，那么
xWs.Name=xName&“（&xInt&”）
如果结束
如果结束
如果结束
下一个
Application.ScreenUpdating=True
端接头

有些工作表确实被重命名，但有些没有，我检查了重复的工作表名称，没有。我还检查了文件名是否在正确的范围内（单元格），它是否存在

我无法解决这个问题，请您提出建议。提前谢谢

问候,，

---

Harsha

如果该值包含一些特殊字符，则可能会出现问题。excel工作表可以有一些名称，如果这是问题，我的代码可能是解决方案。 它将字符串的最大长度剪切为31个字符，并删除名称中不允许的所有特殊字符

Sub RenameSheet()

Dim rs As Worksheet

For Each rs In Sheets
sheetName = without_special_chars(rs.Range("EC1").Value)
If Len(sheetName) > 31 Then
    sheetName = Left(sheetName, 31)
End If
rs.Name = sheetName
Next rs

End Sub

Function without_special_chars(text As String) As String
Dim i As Integer
Const special_chars As String = "-.,:;#+ß'*?=)(/&%$§!~\}][{"
For i = 1 To Len(special_chars)
text = Replace(text, Mid(special_chars, i, 1), "")
Next i
without_special_chars = text
End Function

重命名多个工作表 快速修复

• 您的第一个代码应该是这样的：

  Sub renameWorksheetsQF()
      Dim ws As Worksheet
      For Each ws In ThisWorkbook.Worksheets
          ws.Name = ws.Range("EC1").Value
      Next ws
  End Sub
  

  注意不那么微妙的差别

深入

Option Explicit

Sub renameWorksheets()

    On Error GoTo clearError
    Const cAddress As String = "A1" ' "EC1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet
    Dim cel As Range
    Dim oName As String
    Dim nName As String
    
    For Each ws In wb.Worksheets
        oName = ws.Name
        Set cel = ws.Range(cAddress)
        If IsError(cel) Then
            Debug.Print "Cell '" & cAddress & "' in worksheet '" _
                & oName & "' contains the error value '" & cel.Text & "'."
        Else
            If IsEmpty(cel) Then
                Debug.Print "Cell '" & cAddress & "' in worksheet '" _
                    & oName & "' is an empty cell."
            Else
                nName = CStr(cel.Value)
                On Error GoTo RenameError
                If oName <> nName Then
                    ws.Name = nName
                Else
                    Debug.Print "Worksheet '" & oName _
                        & "' had previously been renamed."
                End If
                On Error GoTo clearError
            End If
        End If
    Next ws
    
ProcExit:
    Exit Sub

RenameError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Debug.Print "     Could not rename '" & oName & "' to '" & nName & "'."
    Resume Next
clearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Debug.Print "     Unexpected error."
    Resume ProcExit
End Sub

选项显式
子重命名工作表（）
关于错误转到clearError
常量cadAddress为String=“A1”'“EC1”
将wb设置为工作簿：设置wb=ThisWorkbook包含此代码的工作簿
将ws设置为工作表
暗淡的cel As范围
把我当作绳子
把我当作绳子
对于wb.工作表中的每个ws
oName=ws.Name
设置cel=ws.范围（CADRESS）
如果是IsError（cel），那么
调试。打印“单元格”&“工作表中的单元格”&“CADRESS&”_
&oName&“包含错误值”&“cel.Text&”
其他的
如果我是空的（cel），那么
调试。打印“单元格”&“工作表中的单元格”&“CADRESS&”_
&oName&“是一个空单元格。”
其他的
nName=CStr（单元值）
错误转到重命名错误
如果是我，那么是我
ws.Name=nName
其他的
调试。在名称上打印“工作表”&_
&“'以前已重命名。”
如果结束
关于错误转到clearError
如果结束
如果结束
下一个ws
程序出口：
出口接头
重命名错误：
Debug.Print“运行时错误”&错误号&“：”&错误说明
Debug.Print“无法将”&oName&“重命名为”&nName&“
下一步继续
clearError：
Debug.Print“运行时错误”&错误号&“：”&错误说明
调试。打印“意外错误”
恢复程序退出
端接头

单元格EC1中的值很可能不是有效的工作表名称（太长或无效字符）。如果@BigBen正确，您可以检查单元格是否包含以下字符之一\、/、*、？：，[，]如果其长度超过31