Sub renameWorksheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
ws.Name = Range("O11").Value & "-" & Range("N11").Value
Next ws
End Sub
因為當我重命名作業表并且有兩個或多個作業表名稱重復時，會出現此錯誤：
該作業表名稱已被占用。嘗試另一個
因此，我希望作業表名稱是否與其他現有作業表相同，然后將作業表重命名為“_2”。如何修改檢測部分？
（更新1）我已經更新了我的代碼，發現仍然有錯誤，有人能給我一些建議嗎？
Sub renameWorksheet()
Dim ws As Worksheet
Dim rename As String
Dim rng As Worksheet
Dim i As Integer
i = 1
For Each ws In ThisWorkbook.Worksheets
rename = rng.Range("O11").Value & "-" & rng.Range("N11").Value & "-" & i
If rename = rng.Name Then
i = i 1
ws.Name = rename
Else
ws.Name = rename
End If
rng.Name = rename
Next ws
End Sub
現在回傳一個錯誤：
物件變數或未設定塊變數
uj5u.com熱心網友回復：
使用增量重命名作業表
- 回圈遍歷作業簿中的所有作業表。
- 它從每個作業表的單元格中構建一個字串，用作作業表的新名稱 (
NewName)。 - 如果新名稱等于 (
vbTextCompare) 作業表名稱，則如果DoCorrectCase設定為True，則重命名更正大小寫 (vbBinaryCompare)。最后，它退出。 - 如果字串不相等，它會嘗試查找具有相同名稱的作業表。
- 如果沒有找到，它會重命名作業表并退出。
- 如果找到，它會向新名稱添加一個增量并繼續執行第 3 步，直到它在第 3 步或第 5 步中退出。
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In the workbook containing this code, by concatenating values
' from two cells in each worksheet, uses the concatenated
' string to rename them.
' Adds an increment if a sheet with the same name already exists.
' Calls: 'RenameWorksheetWithIncrement'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameWorksheets()
Const LeftDelimiter As String = "_"
Const FirstNewIndex As Long = 2
Const RightDelimiter As String = ""
Const DoCorrectCase As Boolean = False
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet
Dim NewName As String
For Each sws In wb.Worksheets
NewName = CStr(sws.Range("O11").Value) _
& "-" & CStr(sws.Range("N11").Value)
RenameWorksheetWithIncrement sws, NewName, _
LeftDelimiter, FirstNewIndex, RightDelimiter, DoCorrectCase
Next sws
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Renames a worksheet. Adds an increment if a sheet
' with the same name already exists.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameWorksheetWithIncrement( _
ByRef sws As Worksheet, _
ByVal NewName As String, _
ByVal LeftDelimiter As String, _
ByVal FirstNewIndex As Long, _
ByVal RightDelimiter As String, _
Optional ByVal DoCorrectCase As Boolean = False)
Const ProcName As String = "RenameWorksheetWithIncrement"
On Error GoTo ClearError
Dim wb As Workbook: Set wb = sws.Parent
Dim nName As String: nName = NewName
Dim nIndex As Long: nIndex = FirstNewIndex
Dim swsName As String: swsName = sws.Name
Dim nws As Worksheet
Do
' Test if already renamed.
If StrComp(swsName, nName, vbTextCompare) = 0 Then ' ignore case
If DoCorrectCase Then
If StrComp(swsName, nName, vbBinaryCompare) <> 0 Then
sws.Name = nName ' correct case
End If
End If
Exit Do
End If
' Attempt to create a reference.
On Error Resume Next ' defer error handling
Set nws = wb.Worksheets(nName)
On Error GoTo ClearError ' enable error handling
'On Error GoTo 0 ' disable error handling (usually, not to be used here)
' Rename.
If nws Is Nothing Then
sws.Name = nName
Exit Do
Else
Set nws = Nothing
nName = NewName & LeftDelimiter & nIndex & RightDelimiter
nIndex = nIndex 1
End If
Loop
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Sub
uj5u.com熱心網友回復：
如果有一個名稱已經帶有“_2”的作業表怎么辦？如果是這種情況，您可能需要多加思考。
試試這個。我已經在我自己的空間中對其進行了測驗，但您可能需要稍微更改代碼以使其適用于您的確切場景......
Sub renameWorksheet()
Dim ws As Worksheet, lngSuffix As Long, strSuffix As String
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
Err.Description = " "
lngSuffix = 1
While Err.Description <> ""
Err.Clear
ws.Name = Range("O11").Value & "-" & Range("N11").Value
If Err.Description <> "" Then
strSuffix = "_" & lngSuffix
lngSuffix = lngSuffix 1
End If
Wend
Next ws
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/382712.html
上一篇：為每個對話框匯入CSV-VBA