[已解决]再问出生日期计算问题

wgl309

我的出生日期计算问题仍没有解决,恳请高手帮忙.

最佳答案

月排行榜 / 总排行榜

wayy

2012-8-3 11:04

1. Sub 出生日期()
   
2. Dim i As Long
   
3. Dim arr1
   
4. arr1 = Range("I2:J" & [I65536].End(xlUp).Row)
   
5. For i = 1 To UBound(arr1)
   
6.   If arr1(i, 1) <> "" Then
   
7.     If Len(arr1(i, 1)) = 18 Then
   
8.       arr1(i, 2) = Format(Mid(arr1(i, 1), 7, 8), "0000-00-00")
   
9.     Else
   
10.       arr1(i, 2) = Format("19" & Mid(arr1(i, 1), 7, 6), "0000-00-00")
    
11.     End If
    
12.   End If
    
13. Next
    
14. [i2].Resize(i - 1, 2) = arr1
    
15. End Sub

复制代码

跳转到最佳答案楼层

wayy

1. Sub 出生日期()
   
2. Dim i As Long
   
3. Dim arr1
   
4. arr1 = Range("I2:J" & [I65536].End(xlUp).Row)
   
5. For i = 1 To UBound(arr1)
   
6.   If arr1(i, 1) <> "" Then
   
7.     If Len(arr1(i, 1)) = 18 Then
   
8.       arr1(i, 2) = Format(Mid(arr1(i, 1), 7, 8), "0000-00-00")
   
9.     Else
   
10.       arr1(i, 2) = Format("19" & Mid(arr1(i, 1), 7, 6), "0000-00-00")
    
11.     End If
    
12.   End If
    
13. Next
    
14. [i2].Resize(i - 1, 2) = arr1
    
15. End Sub

复制代码

wgl309

wayy 发表于 2012-8-3 11:04

VBA还不太了解,能否帮忙把提取性别的语句也写一下,谢谢

wayy

wgl309 发表于 2012-8-3 11:45
VBA还不太了解,能否帮忙把提取性别的语句也写一下,谢谢

1. Sub 性别()
   
2. Dim i As Long
   
3. Dim arr1, xb
   
4. arr1 = Range("F2:J" & [I65536].End(xlUp).Row)
   
5. For i = 1 To UBound(arr1)
   
6.   If arr1(i, 4) <> "" Then
   
7.     If Len(arr1(i, 4)) = 18 Then
   
8.       xb = Mid(arr1(i, 4), 17, 1) Mod 2
   
9.     Else
   
10.       xb = Mid(arr1(i, 4), 15, 1) Mod 2
    
11.     End If
    
12.     If xb = 0 Then
    
13.       arr1(i, 1) = "女"
    
14.     Else
    
15.       arr1(i, 1) = "男"
    
16.     End If
    
17.   End If
    
18. Next
    
19. [f2].Resize(i - 1, 5) = arr1
    
20. End Sub

复制代码