重命名多个电子表格macros

我有一个Excel VBAmacros，需要多个文本文件（50+），并将它们转换成.xlsx电子表格。 我想根据文件的原始名称重新命名这些文件。

我试过使用下面的代码，但它只能用于1个名字。

Sub Rename_Files() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.DisplayStatusBar = False Dim k As Integer Dim t As String Dim x As Integer k = Sheets.Count x = 1 While x <= k t = Sheets(x).Name If t = "validated_deals" Then Sheets(x).Name = "Clauric - Validated Deals" x = x + 1 Else x = x + 1 End If Wend End Sub 

显然，我可以重做每个名称的While循环，但有一个更快的方法来做到这一点，使用循环。 如果有帮助，我将所有文件的名称存储在一个单独的位置。

Answer 1

假设您在column A有旧的工作表名称，并在Sheet4 column B column A新的工作表名称，如下所示：

这里是代码：

 Sub Rename_Files() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.DisplayStatusBar = False Dim k As Integer Dim t As String Dim x As Integer Dim arrOldNames As Variant Dim arrNewNames As Variant 'GETTING THE LAST ROW FROM SHEET4 With Sheets("Sheet4") LRow = .Range("A" & .Rows.Count).End(xlUp).Row End With 'ASSUMING COL-A HOLDS OLD SHEET NAMES AND COL-B HOLDS NEW SHEET NAMES ON SHEET4 arrOldNames = Sheets("Sheet4").Range("A2:A" & LRow).Value arrNewNames = Sheets("Sheet4").Range("B2:B" & LRow).Value k = Sheets.Count x = 1 While x <= k t = Sheets(x).Name x = x + 1 'HERE WE'LL RUN A LOOP ON ALL THE NAMES AND CHANGE THE NAME IF MATCHES For i = 1 To UBound(arrOldNames) If arrOldNames(i, 1) = t Then Sheets(x - 1).Name = arrNewNames(i, 1) Exit For End If Next Wend Application.ScreenUpdating = True Application.DisplayAlerts = True Application.DisplayStatusBar = True End Sub 

这个子将创build两个数组，一个保存旧名称，另一个保存新名称。 它将在每个名称上运行一个循环，如果名称匹配，则会更改名称。

– >确保你有相同数量的名字（新旧）。