|
Sub ExtractMonth()
Dim regEx As Object, dataArr As Variant, resultArr() As Variant
Dim i As Long, lastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") '按实际修改工作表名
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
dataArr = ws.Range("A1:A" & lastRow).Value
ReDim resultArr(1 To UBound(dataArr), 1 To 1)
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "(\d{1,2})月份"
For i = 1 To UBound(dataArr)
If regEx.Test(dataArr(i, 1)) Then
resultArr(i, 1) = regEx.Execute(dataArr(i, 1))(0).SubMatches(0)
End If
Next i
ws.Range("D1:D" & lastRow).Value = resultArr
End Sub
|
|