|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 玉阳山人 于 2020-1-20 13:53 编辑
按间隔序号为周期多条件计数.zip
(398 KB, 下载次数: 3)
老师:经多次验证,发现我先前在附件里所说的最大序号的指定不对--不能是序号区域E5:E5000最大的那个序号【E1931里的4623】,而应该调用G1指定的总表最大序号才对【惟有这样,表二的L664:N664才能显示正确的结果 0,2,3】!
为此,需要:
1.在参数序号区域后面,增添一个新的参数-总表最大序号【此参数可以是数字常量,单元格调用,或公式计算结果】;
2.直接用总表最大序号G1作为满额与不满额周期选择【第五参数】的计算基数,而不再使用序号区域E5:E5000中的最大序号【E1931里的4623】作计算基数。为此,需要对下面代码的红色部分进行修改。
3.下面原代码参数的先后顺序是: =XHCOUNTIF(数据区域,指定需要计数的数据,每周期间隔序号,满额与不满额周期选择,序号区域),
添加参数【总表最大序号】后,最好变成这样的顺序:=XHCOUNTIF(数据区域,序号区域,总表最大序号,每周期间隔序号,满额与不满额周期选择,指定需要计数的数据),
如:选定L5:L5000,输入区域数组公式 { =XHCOUNTIF($G$5:$G$5000,$E$5:$E$5000【可省略】,$G$1,$N$1,$N$2,L$4),看起来清楚明了,一目了然!
原代码如下:
Option Explicit
Public Function XHCOUNTIF(QY As Range, tj, ZQ, Optional x = 0, Optional y As Range, Optional lngStart As Long = 5)
Application.Volatile
Dim arr As Variant, brr As Variant, crr As Variant, lngCol As Long
Dim lngMaxRound As Long, lngMax As Long, lngRow As Long
Dim lngID As Long, lngVal As Long
arr = QY
lngCol = 5 - QY.Column
If y Is Nothing Then
crr = QY.Offset(, lngCol)
Else
crr = y
End If
'满期计算,满期为0,不满返回最后的周期号
lngMax = Application.WorksheetFunction.Max(crr)
If (lngMax - lngStart + 1) / ZQ = (lngMax - lngStart) \ ZQ Then
lngMaxRound = 0
Else
lngMaxRound = (lngMax - lngStart) \ ZQ + 1
End If
lngMax = (lngMax - lngStart) \ ZQ + 1
ReDim brr(1 To UBound(crr), 1 To 1) As Variant
For lngRow = 1 To UBound(brr)
brr(lngRow, 1) = ""
Next
For lngRow = 1 To UBound(arr)
If lngRow <= lngMax Then brr(lngRow, 1) = Val(brr(lngRow, 1))
If Trim(arr(lngRow, 1)) <> "" Then
lngVal = Val(arr(lngRow, 1))
If lngVal = tj Then
lngID = ((crr(lngRow, 1) - lngStart) \ ZQ) + 1
brr(lngID, 1) = Val(brr(lngID, 1)) + 1
End If
End If
Next
If x = 0 And lngMax <> 0 Then
brr(lngMax, 1) = ""
End If
XHCOUNTIF = brr
End Function
|
|