如何根據excel vba中的單元格值增量重命名工作表

Question

我有一個包含多個值但結構相同的電子表格。 我想根據單元格值“E1”重命名工作表。

但是，E1 中有多個具有相同值的工作表。 如何將工作表 abc01（如果單元格 E1=abc）和單元格 E1=abc 的相應工作表重命名為 abc02，依此類推。

我試過了

Sub RenameWorksheet()

Dim WS As Worksheet
     For Each WS In ThisWorkbook.Worksheets
            WS.Name = WS.Range("E1").Value
     Next WS
End Sub

如果我在單元格 E1 中有多個具有相同值的工作表，則此代碼失敗

任何幫助表示贊賞...

Answer 1

試試這個...

Sub ReNameSheets()
Dim ws As Worksheet
Dim i As Long, cnt As Long
Dim shIdx As Long
For Each ws In Worksheets
    If InStr(LCase(ws.Name), LCase(ws.Range("E1").Value)) = 0 Then
        For i = 1 To Worksheets.Count
            If InStr(LCase(Sheets(i).Name), LCase(ws.Range("E1").Value)) > 0 Then
                cnt = cnt + 1
                If Right(Sheets(i).Name, 2) > shIdx Then shIdx = Right(Sheets(i).Name, 2)
            End If
        Next i
        If cnt > 0 Then
            cnt = shIdx + 1
            ws.Name = ws.Range("E1").Value & Format(cnt, "00")
        Else
            ws.Name = ws.Range("E1").Value & "01"
        End If

        cnt = 0
        shIdx = 0
    End If
Next ws
End Sub

Answer 2

創建一個計數器變量並在 For Each 循環中增加該變量。 之后，您可以將數字附加到 E1 的值。

Answer 3

如您所見，工作表名稱必須是唯一的。 如果該名稱已存在，您可以將索引添加到該名稱的末尾。

Sub RenameWorksheet()
    Dim WS As Worksheet
    With ThisWorkbook
        For Each WS In .Worksheets
            WS.Name = WS.Range("E1").Value & IIf(Exists(WS.Range("E1").Value), WS.Index, vbNullString)
        Next WS
    End With
End Sub

Function Exists(ByVal Name As String) As Boolean
    Dim WS As Worksheet
    With ThisWorkbook
        For Each WS In .Worksheets
            If WS.Name = Name Then
                Exists = True
                Exit Function
            End If
        Next WS
    End With
End Function