重命名基于列表的工作表（Microsoft Excel）

Sub RenameSheets()

Dim c As Range     Dim J As Integer

J = 0     For Each c In Range("A1:A12")

J = J + 1         If Sheets(J).Name = "Control" Then J = J + 1         Sheets(J).Name = c.Text     Next c End Sub

Sub RenameSheets()

Dim c As Range     Dim J As Integer     Dim K As Integer     Dim sName As String     Dim w(12) As String     Dim bGo As Boolean     Dim sTemp As String

bGo = True     If Worksheets.Count <> 13 Then         ' Check to make sure exactly 13 worksheets in workbook         bGo = False         sTemp = "There are more than 13 worksheets."

End If     If ActiveSheet.Name <> "Control" Then         ' Check to make sure Control is active         bGo = False         sTemp = "Control worksheet is not active."

Else         ' Check for empty and duplicate cells in range         J = 0         For Each c In Range("A1:A12")

sName = Trim(c.Text)

If sName <> "" Then                 For K = 1 to J                     If LCase(w(K)) = LCase(sName) Then                         bGo = False                         sTemp = "Duplicate sheet names in list."

End If                 Next K                 If bGo Then                     ' Everything still good; add name                     J = J + 1                     w(J) = sName                 End If             End If         Next c     End If

If bGo Then         K = 0         For J = 1 To 12             K = K + 1             If Sheets(K).Name = "Control" Then K = K + 1             Sheets(K).Name = w(J)

Next J     Else         MsgBox(sTemp)

End If End Sub