VBA - 从源文件修改工作表命名

Question

我在past中收到了关于获取源文件名和从新的源文件名命名新创建的工作表的问题，即"010117Siemens Hot - Cold Report.xls"和输出"010117"的问题。

但是，该代码仅适用于具有此精确格式的文件名，例如，名为"Siemens Hot - Cold Report 010117.xls"的文件，因为新创建的工作表未在源文件中找到日期而发生错误。

码

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)
On Error GoTo CloseIt
If RegMatches.Count >= 1 Then ' make sure there is at least 1 match
    ThisWorkbook.Worksheets(n).Name = RegMatches(0) ' rename "Sheet2" to the numeric part of the filename
End If

src.Close False
Set src = Nothing

所以，我的问题是，无论文件名中的位置如何，如何让我的代码识别数字串？

Answer 1

码

^\d{0,9}\B|\b\d{0,9}(?=\.)

Usage

我决定创建一个可以在单元格内调用的函数：=GetMyNum(x)其中x是指向单元格的指针（即A1）。

要使下面的代码工作：

1. 打开Microsoft Visual Basic for Applications（ALT + F11）
2. 插入一个新模块（右键单击Project Pane并选择Insert - > Module）。
3. 点击Tools - > References并找到Microsoft VBScript Regular Expressions 5.5，启用它然后点击OK

现在将以下代码复制/粘贴到新模块中：

Option Explicit

Function GetMyNum(Myrange As Range) As String
    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String
    Dim match As Object

    strPattern = "^\d{0,9}\B|\b\d{0,9}(?=\.)"

    If strPattern <> "" Then
        strInput = Myrange.Value

        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With

        If regEx.test(strInput) Then
            Set match = regEx.Execute(strInput)
            GetMyNum = match.Item(0)
        Else
            GetMyNum = ""
        End If
    End If
End Function

---

结果

Input

• A1：Siemens Hot - Cold Report 010117.xls
• A2：010117Siemens Hot - Cold Report.xls
• B1：=GetMyNum(A1)
• B2：=GetMyNum(A1)

Output

010117        # Contents of B1
010117        # Contents of B2

---

说明

我将分别解释每个正则表达式选项。您可以按重要性对选项进行重新排序，使最重要的选项是第一个，最不重要的是最后一个选项。

• ^\d{0,9}\B符合以下条件 ^在线的开头断言位置 \d{0,9}匹配任何数字0-9次 \B确保位置与单词边界匹配的位置不匹配（这是使用但可能会根据使用情况而丢弃 - 我添加了它，因为看起来你想要获得的数字后面紧跟一个单词字符，后面没有空格 - 如果情况并非总是这样，只需删除此令牌）
• \b\d{0,9}(?=\.)符合以下条件 \b将位置断言为单词边界 \d{0,9}匹配任何数字0-9次 (?=\.)确定字面点.的正向前瞻

Answer 2

只是我对RegEx的替代解决方案:)

这找到了第一次出现6个连续数字，省略了空白和句号......虽然使用IsNumeric可能还有一些问题，因为我认为小写的e被认为是可以接受的......

Sub FindTheNumber()

For i = 1 To Len(Range("A1").Value)
    If IsNumeric(Mid(Range("A1").Value, i, 6)) = True And InStr(Mid(Range("A1").Value, i, 6), " ") = 0 And InStr(Mid(Range("A1").Value, i, 6), ".") = 0 Then
        MyNumber = Mid(Range("A1").Value, i, 6)
        Debug.Print MyNumber
        Exit For
    End If
Next i

For i = 1 To Len(Range("A2").Value)
    If IsNumeric(Mid(Range("A2").Value, i, 6)) = True And InStr(Mid(Range("A2").Value, i, 6), " ") = 0 And InStr(Mid(Range("A2").Value, i, 6), ".") = 0 Then
        MyNumber = Mid(Range("A2").Value, i, 6)
        Debug.Print MyNumber
        Exit For
    End If
Next i

End Sub

例子：

即时窗口：