VBA将家庭成员单元格中的出生日期更改为年龄

yjwdjfqb

VBA将家庭成员单元格中的出生日期更改为年龄

将家庭成员列复制，在后面列插入，并将人员的生日年月改为年龄
如图：
请大家帮帮忙，谢谢老师们了！


VBA将家庭成员单元格中的出生日期更改为年龄.rar (1.85 KB, 下载次数: 10)

2016-12-8 12:44 上传

点击文件名下载附件

marchwen01

1. Sub aTest()
   
2.     Dim arr, tmp, rg As Range
   
3.     Dim i As Integer
   
4.    
   
5.     For Each rg In Range("d2", [d2].End(4).Address)
   
6.         arr = Split(rg.Value, Chr(10))
   
7.         For i = 0 To UBound(arr)
   
8.             arr(i) = Replace(arr(i), ".", "-")
   
9.             tmp = Split(arr(i), " ")
   
10.             tmp(2) = DateDiff("yyyy", CDate(tmp(2)), Date)
    
11.             arr(i) = Join(tmp, " ")
    
12.         Next
    
13.         rg.Offset(0, 2) = Join(arr, Chr(10))
    
14.     Next
    
15. End Sub

复制代码

如果想在原单元格修改，把
rg.Offset(0, 2) = Join(arr, Chr(10))
改成
rg.Value= Join(arr, Chr(10))

yjwdjfqb

marchwen01 发表于 2016-12-8 13:19
如果想在原单元格修改，把
rg.Offset(0, 2) = Join(arr, Chr(10))
改成

谢谢老师了，很好用！

yjwdjfqb

marchwen01 发表于 2016-12-8 13:19
如果想在原单元格修改，把
rg.Offset(0, 2) = Join(arr, Chr(10))
改成

老师你好，这个日期中，月和日、怎么不起作用呢
如：
父亲 梁彦生 1952.12.09 群众 务农
这个应该是63岁，到了明天2016.12.09才64岁

但结果，是64岁，请老师帮帮看下，谢谢了！
2 - 上传.rar (9.08 KB, 下载次数: 3)

2016-12-8 17:50 上传

点击文件名下载附件

marchwen01

可能这是 Datediff 函数的特性吧。那就不用系统的函数，用自己写的 Years 函数

1. Sub Test()
   
2.     Dim arr, tmp, rg As Range
   
3.     Dim i As Integer
   
4. 
   
5.     For Each rg In Range("d2", [d2].End(4).Address)
   
6.         arr = Split(rg.Value, Chr(10))
   
7.         For i = 0 To UBound(arr)
   
8.             arr(i) = Replace(arr(i), ".", "-")
   
9.             tmp = Split(arr(i), " ")
   
10.             tmp(2) = Years(CDate(tmp(2)), Date)
    
11.             arr(i) = Join(tmp, " ")
    
12.         Next
    
13.         rg.Offset(0, 2) = Join(arr, Chr(10))
    
14.     Next
    
15. End Sub
    
16. 
    
17. Function Years(startDate As Date, endDate As Date) As Integer
    
18.     Dim MyYear As Integer
    
19.     Dim tmp As Date
    
20.     MyYear = Year(endDate) - Year(startDate)
    
21.     tmp = CDate(Year(endDate) & "-" & Month(startDate) & "-" & Day(startDate))
    
22.     Years = IIf(tmp > endDate, MyYear - 1, MyYear)
    
23. End Function
    

复制代码

marchwen01

刚才的回复要审核，直接上附件吧。

yjwdjfqb

marchwen01 发表于 2016-12-8 18:54
刚才的回复要审核，直接上附件吧。

谢谢老师啦！这下完美了！

ykqrs

也可用正则处理

1. Sub qq()
   
2. Dim arr, i%, reg, r%, s$, ss As Date, s1%
   
3. Set reg = CreateObject("vbscript.regexp")
   
4. r = Cells(Rows.Count, "d").End(xlUp).Row
   
5. arr = Range("d1:d" & r)
   
6. For i = 2 To r
   
7. reg.Pattern = "\d{4}\.\d{2}\.\d{2}"
   
8. s = arr(i, 1)
   
9. Do While reg.Test(s)
   
10. ss = Replace(reg.Execute(s)(0), ".", "-")
    
11. s1 = DateDiff("yyyy", ss, Date) - IIf(Date >= DateSerial(Year(Date), Month(ss), Day(ss)), 0, 1)
    
12. s = reg.Replace(s, s1)
    
13. arr(i, 1) = s
    
14. Loop
    
15. Next
    
16. Range("f1:f" & r) = arr
    
17. End Sub

复制代码

ykqrs

VBA将家庭成员单元格中的出生日期更改为年龄.rar (9.92 KB, 下载次数: 9)

2016-12-9 10:46 上传

点击文件名下载附件