求助如何将单元格内的月份提取出来

禁忌の双极

如图所示，我需要将月份提取出来，同时对单元格内没有月份的不提取出来，也不提取多余的数字出来，如同效果列一样，请问该如何用VBA代码提取出来


注意，尽量简洁高效一些，毕竟还有其他代码要运行，我不想卡上两三秒，麻烦各位大佬帮帮忙了

zxsea_7426

正则提取最好

gwjkkkkk

1. =IFNA(TEXTBEFORE(REGEXP(A2,"(\d+)月份"),"月"),"")

复制代码

公式简单一点

zxsea_7426

gwjkkkkk 发表于 2025-4-6 16:13
公式简单一点

果然还是高版本的方便啊。

quqiyuan

参与一下，楼主需要VBA就来VBA吧，现在365的正则函数也方便，仅供参考，，，

quqiyuan

代码如下。。。
Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    t = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    arr = sht.[a1].CurrentRegion
    Set reg = CreateObject("VBScript.RegExp")
    ReDim brr(1 To UBound(arr) - 1, 0)
    For i = 2 To UBound(arr)
        With reg
            .Pattern = "(\d+)月"
            .Global = False
            .IgnoreCase = True
            .MultiLine = True
        End With
        If reg.test(arr(i, 1)) Then
            Set matchs = reg.Execute(arr(i, 1))
            Set mat = matchs(0).submatches
            brr(i - 1, 0) = mat(0)
        End If
    Next
    sht.[d2].Resize(UBound(brr)) = brr
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub

ykcbf1100

正则提取月份

ykcbf1100

1. Sub ykcbf()   '//2025.4.6
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = [a1].Resize(r, 2)
   
4.     For i = 2 To UBound(arr)
   
5.         arr(i, 2) = ston(arr(i, 1))
   
6.     Next
   
7.     [a1].Resize(r, 2) = arr
   
8.     ActiveWindow.DisplayZeros = False
   
9. End Sub
   
10. 
    
11. Function ston(text) As Integer
    
12.     Set reg = CreateObject("VBScript.RegExp")
    
13.     With reg
    
14.         .Global = True
    
15.         .Pattern = "(\d+)月份"
    
16.         .IgnoreCase = True
    
17.     End With
    
18.     If reg.test(text) Then
    
19.         Set mh = reg.Execute(text)
    
20.         ston = Val(mh(0).Value)
    
21.     End If
    
22. End Function
    

复制代码

无关岁月

1. =REGEXP(A2,".*?\K\d+(?=月)|^")

复制代码

禁忌の双极

quqiyuan 发表于 2025-4-6 17:17
代码如下。。。
Sub test()
    Application.ScreenUpdating = False

大佬你好，感谢你的帮助，但是为什么我这边将代码移到我的工作簿后反而没有用了，你可以帮看下是哪里的问题吗