如何用正則求幾年幾月幾日的年月日及相加後年月日

shi353

工作會用到幾年幾月幾日的相加及抽出年月日值

想要的結果在附件藍色字顯現，煩請各位大神先進們指導解惑
主要用正則，其他的方法也可提供

taller

这么规范的数据，无须强求用正则，split就可以完美拆分年月日

相加可以使用日期格式相加，然后去提出数字，这样就不需要考虑进位问题

Chip_Kenny

樓主模擬的答案有問題, 詳看附件。

lsdongjh

1. Sub Test()
   
2.     Dim rg As Range, arr As Variant, lngRow As Long
   
3.     Dim strTemp As String, strSplit() As String
   
4.     Dim intYear  As Integer, intMonth  As Integer, intDay As Integer
   
5.    
   
6.     Set rg = Sheet1.Range("F1:I5")
   
7.     arr = rg
   
8.    
   
9.     For lngRow = 2 To 3
   
10.         strTemp = arr(lngRow, 1)
    
11.         strSplit = Split(strTemp, "年")
    
12.         arr(lngRow, 2) = Val(strSplit(0))
    
13.         
    
14.         strTemp = strSplit(1)
    
15.         strSplit = Split(strTemp, "月")
    
16.         arr(lngRow, 3) = Val(strSplit(0))
    
17.         
    
18.         strTemp = strSplit(1)
    
19.         strSplit = Split(strTemp, "日")
    
20.         arr(lngRow, 4) = Val(strSplit(0))
    
21.     Next
    
22.    
    
23.     intDay = (arr(2, 4) + arr(3, 4)) Mod 30
    
24.     intMonth = (arr(2, 4) + arr(3, 4)) \ 30
    
25.             
    
26.     intMonth = intMonth + arr(2, 3) + arr(3, 3)
    
27.     intYear = intMonth \ 12
    
28.     intMonth = intMonth Mod 12
    
29.    
    
30.     intYear = intYear + arr(2, 2) + arr(3, 2)
    
31.         
    
32.     arr(5, 1) = intYear & "年" & intMonth & "月" & intDay & "日"
    
33.    
    
34.     rg = arr
    
35. End Sub
    

复制代码

爱吃蜂蜜的狼

这个是拆分日期的（日期相加的你直接用if判断完用MOD函数取余数就可以了）

Sub test()
Set regx = CreateObject("vbscript.regexp")
'Dim regx As New RegExp
regx.Global = True
regx.Pattern = "\d+"
For Each Rng In Range("A2:A3,F2:F3")
Set mat = regx.Execute(Rng)
    Cells(Rng.Row, Rng.Column + 1) = mat(0).Value
    Cells(Rng.Row, Rng.Column + 2) = mat(1).Value
    Cells(Rng.Row, Rng.Column + 3) = mat(2).Value
Next
End Sub

mzbao

A-D列的

1. Sub test()
   
2.     Dim txt$, r%, i%, arr, brr(0 To 2) As Integer
   
3.    
   
4.     For r = 2 To 3
   
5.         txt = Cells(r, "A").Value
   
6.         For i = 1 To 3
   
7.             txt = Replace(txt, Mid("年月日", i, 1), " ")
   
8.         Next
   
9.         arr = Split(Trim(txt))
   
10.         With Cells(r, "B").Resize(1, 3)
    
11.             .Value = arr
    
12.             .Value = .Value
    
13.         End With
    
14.         For i = 0 To 2
    
15.             brr(i) = brr(i) + arr(i)
    
16.         Next
    
17.     Next r
    
18.    
    
19.     If brr(2) > 30 Then '日进位
    
20.         brr(1) = brr(1) + Int(brr(2) / 30)
    
21.         brr(2) = brr(2) Mod 30
    
22.     End If
    
23.     If brr(1) > 12 Then '月进位
    
24.         brr(0) = brr(0) + Int(brr(1) / 12)
    
25.         brr(1) = brr(1) Mod 12
    
26.     End If
    
27.    
    
28.     Cells(5, "A") = brr(0) & "年" & brr(1) & "月" & brr(2) & "日"
    
29. End Sub

复制代码

shi353

mzbao 发表于 2019-4-17 15:52
A-D列的

謝謝 可以用解決了我的問題

shi353

lsdongjh 发表于 2019-4-17 12:32

感謝，讓我完全了解可用split 多重取值的應用
完美解決了我的問題

zzuhmin

shi353 发表于 2019-4-17 21:11
感謝，讓我完全了解可用split 多重取值的應用
完美解決了我的問題

您好，我有一个看到一个您之前做的一个实现word邮件合并的VBA,我参考你的那个VBA做了一个，但是无法实现循环，能帮忙看下问题出在哪里么，我等级太低，不能加您好友，我发了贴，能指导一下么？大神