Question

这个问题与renaming multiple worksheets from list using VBA模糊地相似，但是太过不同，无法从这个问题中得到答案。

我将经常需要在各种传入工作簿中重命名数十个工作表。

我希望重命名所有工作表，首先将所有工作表名称复制到secondWorkbook.sheets（1）colA中，在ColB中手动创建新名称，然后运行第二个宏来更新originalWorkbook中的名称。

我被困在第二个宏上，但会在下面提供两个宏。 如果有人有更短/更好的方式来编写这些宏，我就是所有人。

第一个宏 - 将所有工作表名称复制到新的workbook.sheet（1）.colA中。 这样可行，并使用ColA

中的选项卡名称创建一个新的未保存的工作簿

Sub GrabAllTabNamesIntoTempWorkbookColA()
    Dim tst, tmp, allTabNames As String
    Dim i, cnt, cnt2 As Long
    Dim wb, wbTmp As Workbook, xWs, ws1 As Worksheet
    Dim arrOldNames, arrNewNames As Variant

    ReDim arrOldNames(999)
    cnt = 0

    With ActiveWorkbook
        For Each xWs In .Worksheets
            If xWs.Visible = xlSheetVisible Then
                arrOldNames(cnt) = xWs.Name
                cnt = cnt + 1
            End If
        Next
    End With
    ReDim Preserve arrOldNames(cnt - 1)

    cnt2 = 1
    Set wbTmp = Workbooks.Add
    Set ws1 = wbTmp.Sheets(1)
    For i = 1 To cnt
        ws1.Range("A" & i).Value = arrOldNames(i - 1)
    Next

    MsgBox "Done. Copied " & cnt & " tab names."

End Sub

这是我坚持的宏。这两个工作簿都在屏幕上打开，我不介意编辑宏来提供工作簿名称。不确定如何引用名为“Book4 - Microsoft Excel”的未保存工作簿，因此我将其保存为Temp.xlsx并将其引用为 namesWb 。包含要重命名的选项卡的工作簿被引用为 targetWb

Sub RenameAllTabsFromColAInTempWorkbook()
    Dim namesWb, targetWb As Workbook
    Dim colA, colB As Variant

    Set namesWb = Windows("Temp.xlsx")
    Set targetWb = ActiveWorkbook

    ReDim colA(999), colB(999)
    cnt = 0
    With namesWb
        Sheets(1).Activate
        For i = 1 To 999
            If Range("A" & i).Value = "" Then Exit For
            colA(i - 1) = Range("A" & i).Value
            colB(i - 1) = Range("B" & i).Value
            cnt = cnt + 1
        Next
        ReDim Preserve colA(cnt)
        ReDim Preserve colB(cnt)
    End With

    For each oldname in colA()
        'Stuck here... 
    Next
End Sub

我意识到我可以再次遍历targetWb，并且对于每个tabname，在ColA（）中找到该tabname的位置，并使用tabB（）中相同的位置名称重命名它 - 但我想知道是否有更快/更好的方法来做到这一点。

Answer 1

您可以循环使用这样的活动工作簿：

Sub t()
Dim mainWB As Workbook, tempWB As Workbook
Dim wb As Workbook

Set mainWB = ActiveWorkbook

For Each wb In Application.Workbooks
    'Loops through the workbooks.
    Debug.Print wb.Name
    If wb.Name Like "Book*" Then
        Set tempWB = wb
    End If
Next wb

End Sub

编辑：由于您只有两个打开的工作簿，因此可以缩短它：

Sub t()
Dim mainWB As Workbook, tempWB As Workbook
Dim wb As Workbook

Set mainWB = ActiveWorkbook ' MAKE SURE THIS IS CORRECT!! May need `ThisWorkbook` if the new temporary one becomes the active one.

For Each wb In Application.Workbooks
    'Loops through the workbooks.
    Debug.Print wb.Name
    If wb.Name <> mainWB.Name And wb.Name <> "PERSONAL.XLSB" Then
        Set tempWB = wb
        ' Now do whatever you need with the Temporary workbook.
    End If
Next wb

End Sub

Answer 2

我重构了你的Sub以显示更强大的方法。

使用显式类型（其中一些默认为Variant）来修改所有变量
在名称列表顶部记录正在处理的工作簿
仍在处理ActiveWorkbook
将Temp工作簿保存到与ActiveWorkbook
Rename...现在跳过任何缺少的新名称
检测丢失的OldNames（请参阅代码中的注释，放置您想要的任何响应）
检测失败的重命名（例如，新名称中可能是无效字符）

Sub GrabAllTabNamesIntoTempWorkbookColA()
    Dim wbToRename As Workbook
    Dim wbTmp As Workbook
    Dim xWs As Worksheet
    Dim ws1 As Worksheet
    Dim arrOldNames As Variant
    Dim arrNewNames As Variant
    Dim cnt As Long

    Set wbToRename = ActiveWorkbook
    With wbToRename
        ' Size array based on number of sheets in workbook
        ReDim arrOldNames(1 To .Worksheets.Count, 1 To 1)
        cnt = 0
        For Each xWs In .Worksheets
            If xWs.Visible = xlSheetVisible Then
                cnt = cnt + 1
                arrOldNames(cnt, 1) = xWs.Name
            End If
        Next
    End With


    Set wbTmp = Workbooks.Add
    Set ws1 = wbTmp.Sheets(1)
    'Place data in sheet in one go
    ws1.Cells(1, 1) = wbToRename.Name
    ws1.Cells(2, 1).Resize(UBound(arrOldNames, 1), 1) = arrOldNames

    MsgBox "Done. Copied " & cnt & " tab names."

    'Save workbook
    wbTmp.SaveAs Filename:=wbToRename.Path & "\Temp", FileFormat:=xlOpenXMLWorkbook
End Sub

Sub RenameAllTabsFromColAInTempWorkbook()
    Dim namesWb As Workbook
    Dim targetWb As Workbook
    Dim wsNames As Worksheet
    Dim ws As Worksheet
    Dim NamesList As Variant
    Dim cnt As Long
    Dim i As Long

    Set namesWb = Application.Workbooks("Temp.xlsx")
    Set targetWb = Application.Workbooks(namesWb.Worksheets(1).Cells(1, 1).Value)

    cnt = 0
    Set wsNames = namesWb.Worksheets(1)
    With wsNames
        'Get Names into one variable, based on actual number of rows
        NamesList = wsNames.Range(wsNames.Cells(2, 2), wsNames.Cells(wsNames.Rows.Count, 1).End(xlUp)).Value
        For i = 1 To UBound(NamesList, 1)
            ' Check if the Name has been entered
            If NamesList(i, 2) <> vbNullString Then
                'Get reference to sheet by old name, and handle if sheet is missing
                Set ws = Nothing
                On Error Resume Next
                Set ws = targetWb.Worksheets(NamesList(i, 1))
                On Error GoTo 0
                ' Rename sheet
                If Not ws Is Nothing Then
                    On Error Resume Next
                    ws.Name = NamesList(i, 2)
                    On Error GoTo 0
                    If ws.Name <> NamesList(i, 2) Then
                        ' Rename failed! What now?
                    End If
                Else
                    'Sheet Missing! What now?
                End If
            End If
        Next
    End With

End Sub

Excel VBA - 从另一个工作簿

2 个答案: