1、需求：
根据员工的年龄，分年龄段统计人数。
2、举例：
接着上一次的例子，得到了出生日期后，然后你又得到任务，需要分年龄段统计人数。
序号 | 年龄段 | 人数 |
|---|---|---|
1 | 20以下 | |
2 | 20-35 | |
3 | 35-45 | |
4 | 45-55 | |
5 | 55以上 |
算年龄用Year函数获取年份，用当前的年份减就可以了。
其实熟悉函数的话，这个用LOOKUP是非常合适的：
代码语言：javascript复制=LOOKUP(E2,{0,"20以下";20,"20-35";35,"35-45";45,"45-55";55,"55以上"})然后再用数据透视表或者SUMIF等方法都可以。
3、代码实现
我们来看看用VBA如何完成这项工作，其实我们也是要实现一个类似LOOKUP的函数，LOOKUP的实现原理应该就是使用了二分法来查找，所谓二分法，从名字上大概就能猜到，它每次查找都能把数据量减半，大概原理如下：
二分法一次就能去掉一半的数据量，查找是非常高效的。100个数字，最多7次就可以找到所需要的数据，是以2为底数，计算数据个数的对数，1亿的数据量的话，最多是27次能找到需要的数据。当然它有一个重要的前提，数据源必须是排序的。
好了，知道了原理，我们用VBA代码来实现它：
代码语言：javascript复制'Arr 数据源，升序
'FindValue 要查找的数据
'找到Arr中刚好小于或等于它、并且下一个大于它的数据，返回下标
Function BinarySearch(arr() As Long, FindValue As Long) As Long
Dim low As Long, high As Long
Dim iMid As Long
Dim iEnd As Long
iEnd = UBound(arr)
high = iEnd
low = LBound(arr)
Do While low <= high
iMid = (high low) 2
If arr(iMid) = FindValue Then
Exit Do
ElseIf arr(iMid) < FindValue Then
'小于的时候还要保证iMid 1是大于它的
If iMid = iEnd Then
Exit Do
Else
If arr(iMid 1) > FindValue Then
Exit Do
End If
End If
'没有退出，说明还要往后面继续查找
low = iMid 1
Else
high = iMid - 1
End If
Loop
If low > high Then
BinarySearch = -1
Else
BinarySearch = iMid
End If
End Function有了这个函数，我们看看如何使用它来分段统计人数，最简单的想法自然是根据返回的下标，在数据源基础上新生成一列年龄段的描述，再根据这个新列用字典对象来统计。
但是，既然函数能够返回年龄段的下标，其实我们直接用数组就可以来统计出现的次数了：
代码语言：javascript复制Enum RetCode
ErrRT = -1
SuccRT = 1
End Enum
Enum Pos
RowStart = 2
姓名 = 3
年龄 = 5
KeyCol = 姓名
Cols = 年龄
End Enum
Type DataStruct
Src() As Variant
Rows As Long
Cols As Long
Result() As Variant
End Type
Sub vba_main()
Dim d As DataStruct
If RetCode.ErrRT = ReadSrc(d) Then Exit Sub
If RetCode.ErrRT = GetResult(d) Then Exit Sub
End Sub
Private Function GetResult(d As DataStruct) As RetCode
ReDim d.Result(1 To 5, 1 To 2) As Variant
d.Result(1, 1) = "20以下"
d.Result(2, 1) = "20-35"
d.Result(3, 1) = "35-45"
d.Result(4, 1) = "45-55"
d.Result(5, 1) = "55以上"
Dim arr(1 To 5) As Long
arr(1) = 0
arr(2) = 20
arr(3) = 35
arr(4) = 45
arr(5) = 55
Dim i As Long
Dim prow As Long
For i = Pos.RowStart To d.Rows
prow = BinarySearch(arr, VBA.CLng(d.Src(i, Pos.年龄)))
d.Result(prow, 2) = d.Result(prow, 2) 1
Next
Range("A1").Offset(1, Pos.Cols 1).Resize(5, 2).Value = d.Result
End Function
Private Function ReadSrc(d As DataStruct) As RetCode
ReadSrc = ReadData(d.Src, d.Rows, Pos.Cols, Pos.KeyCol, Pos.RowStart)
End Function
Private Function ReadData(ByRef RetArr() As Variant, ByRef RetRow As Long, Cols As Long, KeyCol As Long, RowStart As Long) As RetCode
ActiveSheet.AutoFilterMode = False
RetRow = Cells(Cells.Rows.Count, KeyCol).End(xlUp).Row
If RetRow < RowStart Then
MsgBox "没有数据"
ReadData = RetCode.ErrRT
Exit Function
End If
RetArr = Cells(1, 1).Resize(RetRow, Cols).Value
ReadData = RetCode.SuccRT
End Function结果：
技巧：
这个问题其实还能有一个很好的技巧，我们观察需要统计的数据，很明显，数据是比较小的，不会超过100，而且又是数字，我们先记录1-100的数字对应的年龄段的下标，再判断年龄属于哪个区间段的时候，直接读取数组就可以了，省去了二分法查找，代码只需要改动GetResult：
代码语言：javascript复制Private Function GetResult(d As DataStruct) As RetCode
ReDim d.Result(1 To 5, 1 To 2) As Variant
d.Result(1, 1) = "20以下"
d.Result(2, 1) = "20-35"
d.Result(3, 1) = "35-45"
d.Result(4, 1) = "45-55"
d.Result(5, 1) = "55以上"
Dim arr(1 To 6) As Long
arr(1) = 0
arr(2) = 20
arr(3) = 35
arr(4) = 45
arr(5) = 55
arr(6) = 101
'技巧：利用1个数组来记录数字的下标
Dim Interval(100) As Long
Dim i As Long, j As Long
For i = 1 To 5
For j = arr(i) To arr(i 1) - 1
Interval(j) = i
Next
Next
Dim prow As Long
For i = Pos.RowStart To d.Rows
'直接通过数组获取年龄段的下标
prow = Interval(VBA.CLng(d.Src(i, Pos.年龄)))
d.Result(prow, 2) = d.Result(prow, 2) 1
Next
Range("A1").Offset(1, Pos.Cols 1).Resize(5, 2).Value = d.Result
End Function在数据量很大的情况，你会非常明显的感觉到这个技巧带来的速度提升。
