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

Question

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

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

CODE

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}(?=\.)

用法

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

要使下面的代码起作用：

1. 打开Microsoft Visual Basic for Applications（ALT + F11）
2. 插入新模块（右键单击项目窗格并选择Insert - ＆gt; Module）。
3. 点击Tools - ＆gt; 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

结果

输入

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

输出

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

示例：

立即窗口：