簡體   English   中英

Excel VBA-重命名另一個工作簿中新名稱的所有工作表

[英]Excel VBA - rename all worksheets from col of new names in another workbook

這個問題與使用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,並為每個選項卡名稱在ColA()中找到該選項卡名稱的位置,並使用來自tabB()的相同位置名稱對其重命名-但我想知道是否有更快/更好的選擇做到這一點的方法。

您可以像這樣循環瀏覽活動的工作簿:

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

我對您的Sub都進行了重構,以顯示一種更強大的方法。

  1. 使用顯式類型將所有變量變暗(您的一些變量默認為Variant)
  2. 在名稱列表的頂部記錄正在處理的工作簿
  3. 仍在處理ActiveWorkbook
  4. 將Temp工作簿保存到ActiveWorkbook所在的文件夾中
  5. Rename...現在跳過所有缺少的新名稱
  6. 檢測丟失的舊名稱(請參閱代碼中的注釋,在此處放置所需的任何響應)
  7. 檢測失敗的重命名(例如,新名稱中的字符可能無效)

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM