VBA – 重命名源文件后的工作表

我有一个问题，关于如何重命名源文件名后，但只有一部分。 所以如果文件名是"010117Siemens Hot - Cold Report .xls" ，我只想要第一个数字。 所以简而言之，我想将"Sheet2"称为"010117" 。

 Sub ImportData() Application.ScreenUpdating = False Dim wkbCrntWorkBook As Workbook Dim wkbSourceBook As Workbook Dim fNameAndPath As Variant Set wkbCrntWorkBook = ActiveWorkbook fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel 2007, *.xls; *.xlsx; *.xlsm; *.xlsa", Title:="Select File To Import") If fNameAndPath = False Then Exit Sub Call ReadDataFromSourceFile(fNameAndPath) Set wkbCrntWorkBook = Nothing Set wkbSourceBook = Nothing ActiveWorkbook.Worksheets("Set Up").Select End Sub Sub ReadDataFromSourceFile(filePath As Variant) Application.ScreenUpdating = False Dim n As Double Dim wksNew As Excel.Worksheet Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) Dim srcRng As Range With src.Worksheets("Sheet1") Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight)) End With With ThisWorkbook Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count)) n = .Sheets.Count .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value End With ' CLOSE THE SOURCE FILE. src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE. Set src = Nothing End Sub 

提前致谢！

Answer 1

使用RegEx对象从文件名（ src.Name ）中提取数字部分（从1到9连续的数字）。

码

 Sub ReadDataFromSourceFile(filePath As Variant) Application.ScreenUpdating = False Dim n As Double Dim wksNew As Excel.Worksheet Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) Dim srcRng As Range With src.Worksheets("Sheet1") Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight)) End With With ThisWorkbook Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count)) n = .Sheets.Count .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value End With ' ======= get the digits part from src.Name using a RegEx object ===== ' RegEx variables Dim Reg As Object Dim RegMatches As Variant Set Reg = CreateObject("VBScript.RegExp") With Reg .Global = True .IgnoreCase = True .Pattern = "\d{0,9}" ' Match any set of 0 to 9 digits End With Set RegMatches = Reg.Execute(src.Name) If RegMatches.Count >= 1 Then ' make sure there is at least 1 match ThisWorkbook.Worksheets(n).Name = RegMatches(0) ' rename new sheets to the numeric part of the filename End If ' CLOSE THE SOURCE FILE. src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE. Set src = Nothing End Sub