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

禁忌の双极

ykcbf1100 发表于 2025-4-6 17:27

大佬你好，我想指定某个工作表使用，应该在哪里加上Sheets("全年支出合计")进去？

ykcbf1100

禁忌の双极 发表于 2025-4-6 18:03
大佬你好，我想指定某个工作表使用，应该在哪里加上Sheets("全年支出合计")进去？

这样改下。。。。

quqiyuan

禁忌の双极 发表于 2025-4-6 18:01
大佬你好，感谢你的帮助，但是为什么我这边将代码移到我的工作簿后反而没有用了，你可以帮看下是哪里的问 ...

需要看你d1那个区域的情况，这个没有实际数据不好判断。

禁忌の双极

quqiyuan 发表于 2025-4-6 19:29
需要看你d1那个区域的情况，这个没有实际数据不好判断。

大致表格是这样，在D列提取月份并在L列依次录入，你看下应该如何调整，一共有3600行的

quqiyuan

禁忌の双极 发表于 2025-4-6 20:22
大致表格是这样，在D列提取月份并在L列依次录入，你看下应该如何调整，一共有3600行的

修改好，仅供参考。。。

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) - 2, 0)
    For i = 3 To UBound(arr)
        s = arr(i, 4)
        With reg
            .Pattern = "(\d+)月份"
            .Global = False
            .IgnoreCase = True
            .MultiLine = True
        End With
        If reg.test(s) Then
            Set matchs = reg.Execute(s)
            Set mat = matchs(0).submatches
            brr(i - 2, 0) = mat(0)
        End If
    Next
    sht.[l3].Resize(UBound(brr)) = brr
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub

禁忌の双极

quqiyuan 发表于 2025-4-6 20:31
修改好，仅供参考。。。

感谢大佬，多亏有你帮忙，谢谢啦
方便的话可以加下注释，让我学习学习一下吗，万一需要改位置的话我也可以自己手动改了

禁忌の双极

ykcbf1100 发表于 2025-4-6 18:10
这样改下。。。。

感谢大佬提供帮助，谢谢啦

禁忌の双极

quqiyuan 发表于 2025-4-6 20:31
修改好，仅供参考。。。

多谢大佬帮助了

禁忌の双极

quqiyuan 发表于 2025-4-6 20:31
修改好，仅供参考。。。

方便的话可以添加注释让我学习一下吗，万一改位置了我自己也可以自己改了