Question

我的文件夹中有几个excel文件，并且只想重命名包含该文件夹中每个文件的特定工作表

即。 GTLB，SALARY，GROC

每个文件都有一个以上字符的表，其他表有不同的名称。因此，如果工作表名称包含上述字符，则将其更改为杂货。

预先感谢

Answer 1

尝试使用它会循环浏览文件夹，尝试查找文件（excel文件），然后尝试在已指定的文件中查找字符串，如果找到匹配项，则更改名称。

  Sub LoopThroughFiles()
 'loops through all files in a folder
Dim MyObj As Object, MySource As Object, file As Variant
Dim wbk As Workbook
Dim path As String
Dim st As String

file = Dir("H:\TestCopy\testing\") 'file name
path = "H:\TestCopy\testing\" 'directory path

While (file <> "")
Set wbk = Workbooks.Open("H:\TestCopy\testing\" & file)
     MsgBox "found " & file
    ' path = path & file 'path and filename
     Call newloopTrhoughBooks
     wbk.Save
     wbk.Close
   ' Call loop_through_all_worksheets(path)
 file = Dir
Wend
End Sub

 Sub newloopTrhoughBooks()
 Dim book As Workbook, sheet As Worksheet, text As String, text1 As String
  Dim logic_string As String
   Dim logic_string2 As String
  Dim logic_string3 As String

   logic_string = "GTLB"
    logic_string2 = "SALARY"
    logic_string3 = "GROC"

   For Each book In Workbooks
  text = text & "Workbook: " & book.Name & vbNewLine & "Worksheets: " &   vbNewLine

  For Each sheet In book.Worksheets
  text = text & sheet.Name & vbNewLine
  text1 = sheet.Name
   If StrComp(logic_string, text1) = 1 Or StrComp(logic_string2, text1) = 1 Or StrComp(logic_string3, text1) = 1 Then 'compare file name
  ActiveSheet.Name = text1
  ActiveSheet.Name = "Change1"
  End If
  Next sheet
 text = text & vbNewLine
 Next book
MsgBox text

 End Sub

Answer 2

Sub RenameSheets()
Dim MyFolder As String
Dim MyFile As String
Dim wbname As String

MyFolder = "E:\SSS\File Name"
MyFile = Dir(MyFolder & "\*.xls")
Application.ScreenUpdating = False
Do While MyFile <> ""

    Workbooks.Open Filename:=MyFolder & "\" & MyFile
    With ActiveWorkbook
        wbname = "GROCERY"
'For giving filename to sheet1
       'Left(.Name, InStr(.Name, ".") - 1)
        For Each sheet In ActiveWorkbook.Sheets
    If LCase(sheet.Name) Like "*salary*" Or LCase(sheet.Name) Like "*gtlb*" Or LCase(sheet.Name) Like "*groc*" Then
        MsgBox "Found! " & sheet.Name
         .Sheets(sheet.Name).Name = wbname
          .Close savechanges:=True
    End If
Next
       '.Sheets(1).Name = wbname
        '.Close savechanges:=True
    End With
    MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

从特定的文件夹子文件夹重命名特定的工作表

2 个答案: