php统计年龄段人数,根据出生年月分地区统计年龄段

Sub test()

Dim d, arr, i%, brr, k, t

Set d = CreateObject("scripting.dictionary")

arr = Split("行号,地市,30岁以下,30(含30)-50,50(含50)-60,60(含70)-70,70(含70)岁以上,空白未填写,合计", ",")

Sheet1.Activate

la = CDate(WorksheetFunction.Large([p3:p28], 1))

On Error Resume Next

endtime = CDate(InputBox("输入截止日期", "输入日期", Date))

If Err.Number <> 0 Then Exit Sub

If endtime < la Then MsgBox "输入日期小于最年轻的人员的出生年份": Call test

For i = 3 To 28

If IsDate(Cells(i, 16).Value) Then

If Cells(i, 9).Value = "" Then Cells(i, 9).Value = "空白未填写"

d(Cells(i, 9).Value) = IIf(d(Cells(i, 9).Value) = "", DateDiff("yyyy", Cells(i, 16).Value, endtime), _

d(Cells(i, 9).Value) & "," & DateDiff("yyyy", Cells(i, 16).Value, endtime))

Else

d(Cells(i, 9).Value) = d(Cells(i, 9).Value) & "," & "空白未填写"

End If

Next i

k = d.keys

t = d.items

ReDim brr(1 To d.Count + 3, 1 To UBound(arr) + 1)

For i = 1 To UBound(brr, 2)

brr(1, i) = arr(i - 1)

Next i

For i = 3 To UBound(brr) - 1

brr(i, 1) = i - 1: brr(i, 2) = k(i - 3)

For Each c In Split(t(i - 3), ",")

Select Case Val(c)

Case 1 To 29

brr(i, 3) = brr(i, 3) + 1

Case 30 To 49

brr(i, 4) = brr(i, 4) + 1

Case 50 To 59

brr(i, 5) = brr(i, 5) + 1

Case 60 To 69

brr(i, 6) = brr(i, 6) + 1

Case 70 To 120

brr(i, 7) = brr(i, 7) + 1

Case Else

brr(i, 8) = brr(i, 8) + 1

End Select

Next c

Next i

brr(2, 1) = 1: brr(2, 2) = "合计"

For i = 3 To UBound(brr, 2) - 1

For j = 3 To UBound(brr) - 1

brr(j, 9) = brr(j, 9) + brr(j, i)

brr(2, 9) = brr(2, 9) + brr(j, i)

brr(2, i) = brr(2, i) + brr(j, i)

Next j

Next i

brr(UBound(brr), 1) = "注：本表统计截止时间为" & endtime

With Sheet2

.Range("a16").Resize(UBound(brr), UBound(brr, 2))=“”

.Range("a16").Resize(UBound(brr), UBound(brr, 2)) = brr

.Range("a28:d28").Merge

.Range("a28:d28").Font.ColorIndex = 3

End With

End Sub