vba能实现将星期+月日、日+月日、月日+月日、年月日+年月日，想要变为年月日，然后...

宏初学者

大神们帮忙看看，vba能实现将星期+月日、日+月日、月日+月日、年月日+年月日，想要变为年月日，然后跟今天相减得到日差值。我能想到的是把星期去掉，"-"去掉，逗号去掉，就是太多，手动太慢了

小凡、、、

醉眼看尘世

1. Sub test()
   
2. Dim Dic As Object, reGxp As Object, Arr, i&, j&, tmPstr$, Ystr$, Dstr$, Mstr$, tmPobj As Object
   
3. Set Dic = CreateObject("scripting.dictionary")
   
4. tmPstr = ""
   
5. For i = 1 To 12
   
6.     tmp = Format(DateValue("2024-" & i & "-1"), "mmm")
   
7.     If tmPstr = "" Then tmPstr = tmp Else tmPstr = tmPstr & "|" & tmp
   
8.     Dic(tmp) = i
   
9. Next i
   
10. tmPstr = "(\d{1,2})\s+(" & tmPstr & ")(\D+(\d{4}))?"
    
11. Set reGxp = CreateObject("vbScript.regExp")
    
12. reGxp.Global = True
    
13. reGxp.IgnoreCase = True
    
14. reGxp.Pattern = tmPstr
    
15. Debug.Print reGxp.test([a2].Value)
    
16. With Sheet1
    
17.     mrow = .Cells(.Rows.Count, "A").End(3).Row
    
18.     Arr = .[a1].Resize(mrow, 3)
    
19.     With reGxp
    
20.         For i = 2 To UBound(Arr, 1)
    
21.             If .test(Arr(i, 1)) Then
    
22.                 Set tmPobj = .Execute(Arr(i, 1))
    
23.                 For Each m In tmPobj
    
24.                     Dstr = m.submatches(0) & ""
    
25.                     Mstr = m.submatches(1) & ""
    
26.                     Ystr = m.submatches(3) & ""
    
27.                     If Ystr = "" Then Ystr = "2024"
    
28.                 Next m
    
29.                 Arr(i, 2) = DateValue(Ystr & "-" & Dic(Mstr) & "-" & Dstr)
    
30.                 Arr(i, 3) = Arr(i, 2) - Date
    
31.             Else
    
32.                 Arr(i, 2) = "": Arr(i, 3) = ""
    
33.             End If
    
34.         Next i
    
35.     End With
    
36.     .[a1].Resize(UBound(Arr, 1), 3) = Arr
    
37. End With
    
38. 
    
39. End Sub
    

复制代码

quqiyuan

参与一下，仅供参考。。。