VBA-源文件后重命名工作表

Question

我有一个问题，即如何在源文件名之后重命名表，而只是其中的一部分。因此，如果文件名是"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