VBA计算年龄的问题

jbjbzjb

pingshanggl 发表于 2013-11-2 22:34
别人传给我的表格,我没有注意到有格式问题

类似的表格还有好几张呢

原计算周岁的代码有缺陷，比如2012年12月5日出生，在2013年11月2日的时点去计算其周岁，应该为0周岁，而非1周岁。

原楼层附件已更新（此外，既然你已明白“周岁”列单元格格式设置不妥，顺手于新附件中修正了该列单元格的格式）

jbjbzjb

pingshanggl 发表于 2013-11-2 22:34
别人传给我的表格,我没有注意到有格式问题

类似的表格还有好几张呢

原计算周岁代码有缺陷。这可不允许出现错误，否则你的“上级”Excel 水平不行，骂人的水平估计可不低。

比如2012年12月7日出生，于2013年11月2日这一时点去计算其周岁，应该为0周岁，而非1周岁。原楼层附件已更新。

另：顺手于新附件中修正了“周岁”列格式。

晕死，这烂网站，起先跟帖不见效果，刷新多次仍然不见，正觉纳闷，只好耐着性子重新跟帖，竟然发现早先跟帖存在！不骂叽巴也想骂了。

达州张先生

其实计算周岁一般是以8月31日12时为限，即8月31日（含31日）前出生的，当年为1岁，否则为0岁，并不是那一天统计就那一天满一周岁的。但各有要求不同，也许我说的有错

pingshanggl

达州张先生 发表于 2013-11-3 00:24
其实计算周岁一般是以8月31日12时为限，即8月31日（含31日）前出生的，当年为1岁，否则为0岁，并不是那一天 ...

张先生说得完全正确,以每年的8月31日为统计界限,如:2012年8月31日出生为一周岁;2012年9月1日出生为0周岁.

Sub 计算年龄()
      i = Sheet1.Range("c65356").End(3).Row
  　 For s = 4 To i
      Cells(s, 4) = Int(Application.Days360(Application.Text(Cells(s, 3), "####-##-##"), "2013-08-31") / 360)
End Sub

说明：Ｃ列存放"出生年月"，Ｄ列存放年龄(周岁)，请问：上面的ＶＢＡ如何修改？
谢谢　

liumiaomiao

姓名 性别       出生年月 周岁
王平1 女       20110831
王平2 男       20110901
王平3 男       19990101
王平4 男       19991231
王平5 男       20010831
王平6 女       20010901
王平7 男       20000514
王平8 男       20120831
王平9 男       20120910
王平10 男       19980710
王冬5 男       19981018
王冬6 男       19990920
王冬7 男       19991127
王冬8 男       20000407
王冬9 女       19991227
王冬10 女       20000412
王冬11 女       20010101
王冬12 女       20110224
胡乙9 男       20000210
胡乙10 男       19981124
韦焰1 男       19991113
韦焰2 男       20000310
韦焰3 男       19990712
韦焰4 男       20000826
韦焰5 男       19990205
韦焰6 男       20000801
韦焰7 男       19991114
韦焰8 男       20000223
韦焰9 男       19991002


我觉得这些数据有代表性

jbjbzjb

pingshanggl 发表于 2013-11-3 07:54
张先生说得完全正确,以每年的8月31日为统计界限,如:2012年8月31日出生为一周岁;2012年9月1日出生为0周岁. ...

昨晚已经注意到13楼的跟帖，忽然想起你源附件中的那句代码，似乎有“2013－8－31”字样。当初没细看那句代码，是因为那句代码用了什么int，又什么÷360天，又什么Days360函数，感觉整句代码问题多多，就不屑仔细思之，直接写排序的代码了，计算周岁的代码是后来补写的，就更忘了“2013-8-31”这回事了。

13楼的跟帖让我重新细瞧上述那句代码，确定了那句代码的意思是试图通过days360函数取得两个日期间的天数（一年按360天算），然后再除以360天取整得周岁，故恍然大悟：原来统计时点确定为“2013-8-31”。

原楼层附件现已再次更新，昨晚已经发现上述的统计时点，但已到凌晨0点30分，所以无法更新附件。

清风幽闲

Sub g()
lastr = Cells(Rows.Count, 3).End(3).Row
Range("a4:m" & lastr).Sort key1:=[c4], order1:=xlDescending
End Sub

pingshanggl

清风幽闲 发表于 2013-11-3 09:32
Sub g()
lastr = Cells(Rows.Count, 3).End(3).Row
Range("a4:m" & lastr).Sort key1:=[c4], order1:=xlD ...

谢谢你的参与

pingshanggl

jbjbzjb 发表于 2013-11-3 09:29
昨晚已经注意到13楼的跟帖，忽然想起你源附件中的那句代码，似乎有“2013－8－31”字样。当初没细看那句代 ...

Cells(s, 4) = Int(Application.Days360(Application.Text(Cells(s, 3), "####-##-##"), "2013-08-31") / 360)
是这一句

jbjbzjb

pingshanggl 发表于 2013-11-3 10:34
Cells(s, 4) = Int(Application.Days360(Application.Text(Cells(s, 3), "####-##-##"), "2013-08-31") / ...

我只能告诉你：该句代码可能无从改起。

另：从你在18楼和19楼的回帖看，我不想再次跟这帖了，如无特殊情况，此为最后跟帖。