能够按指定行号、列标，动态扩展统计区域的内嵌自定义函数

玉阳山人 · 发表于 2019-11-11 08:04

本帖最后由玉阳山人于 2019-11-11 09:08 编辑

能够按指定行号、列标，动态扩展统计区域的内嵌自定义函数.zip (25.94 KB, 下载次数: 14)

重要提示：第三参数为需要进行统计的数据区域的行号或列标，第四参数为需要进行统计的数据区域的工作表名称。
在对同一类型的多个类似工作表进行统计计算时，经常会遇到因为行、列区域不等的制约，导致无法复制公式的现象发生，无奈得频繁修改各个工作表里所要进行统计的数据区域--如果工作表很多，既麻烦又容易出错，能不能创建一个动态区域的自定义函数，使之能够按照指定行号、列标，来自动扩展需要统计的数据区域大小呢？

这样，如附件所示，只需复制J25:J40的条件格式到其它工作表的合适地方，右拉即可显示所有数据区域的统计结果。

恳请神通广大的大神们，能够按附件里的运算规则和要求，创建一个自定义函数。

玉阳山人 · 发表于 2019-11-11 11:59

顶起！千万别沉了！

lsdongjh · 发表于 2019-11-11 13:45

Option Explicit
Function DTQY(StartID As Variant, EndID As Variant, Optional RowOrColID As Variant = "", Optional shName As String = "") As Variant
Dim rgCur As Range, strRowOrColID As String, strSelType As String
Dim lngCurRow As Long, lngCurCol As Long
Dim SelRow_Start As Long, SelRow_End As Long
Dim SelCol_Start As Long, SelCol_End As Long
Dim SelSh As Worksheet, arrResult As Variant
'取得公式所在单元格的信息
Set rgCur = Application.Caller
lngCurRow = rgCur.Row
lngCurCol = rgCur.Column
'获取工作表
If Trim(shName) = "" Then
Set SelSh = rgCur.Worksheet
Else
Set SelSh = GetShByName(Trim(shName))
End If
If SelSh Is Nothing Then
DTQY = "表名不存在"
Exit Function
End If
'判断参数类型
If IsNumeric(StartID) Then
strSelType = "ROW"
Else
strSelType = "COL"
End If
'如果参数1与参数2类型不一致，退出
If IsNumeric(StartID) <> IsNumeric(EndID) Then
DTQY = "参数1、2类型不一致"
Exit Function
End If
'如果参数1、2的类型与参数3相同，退出
If RowOrColID <> "" And (IsNumeric(StartID) = IsNumeric(RowOrColID)) Then
DTQY = "参数3类型不对"
Exit Function
End If
'如果行号参数不对，退出
If IsNumeric(StartID) And (Val(StartID) < 1 Or Val(StartID) > Rows.Count) Then
DTQY = "参数1设置有误"
Exit Function
End If
If IsNumeric(EndID) And (Val(EndID) < 1 Or Val(EndID) > Rows.Count) Then
DTQY = "参数2设置有误"
Exit Function
End If
'设置第三参数
strRowOrColID = Trim(UCase(RowOrColID))
'根据传入的参数，设置区域参数
Select Case strSelType
Case "ROW" '设置参数为行号
SelRow_Start = Val(StartID) '起始行
SelRow_End = Val(EndID) '结束行
'根据第三参数获取列号
If strRowOrColID <> "" Then
lngCurCol = GetColIDByStr(strRowOrColID)
End If
'列号有误，退出
If lngCurCol = 0 Then
DTQY = "参数3设置有误"
Exit Function
End If
'返回选择区域
arrResult = SelSh.Range(SelSh.Cells(SelRow_Start, lngCurCol), SelSh.Cells(SelRow_End, lngCurCol))
Case "COL" '设置参数为列号
SelCol_Start = GetColIDByStr(CStr(StartID)) '起始列
SelCol_End = GetColIDByStr(CStr(EndID)) '结束列
If SelCol_Start * SelCol_End = 0 Then
DTQY = "参数1、2设置有误"
Exit Function
End If
'根据第三参数获取行号
If strRowOrColID <> "" Then
lngCurRow = Val(strRowOrColID)
End If
'行号有误，退出
If lngCurRow < 1 Or lngCurRow > Rows.Count Then
DTQY = "参数3设置有误"
Exit Function
End If
'返回选择区域
arrResult = SelSh.Range(SelSh.Cells(lngCurRow, SelCol_Start), SelSh.Cells(lngCurRow, SelCol_End))
End Select
'返回最终结果区域
DTQY = arrResult
End Function
'根据列名，返回列标索引
Function GetColIDByStr(strColName As String) As Long
Dim strAddress As String, lngLen As Long
Dim lngIndex As Long, strChar As String
Dim lngColID As Long
strAddress = Trim(UCase(strColName))
lngLen = Len(strAddress)
For lngIndex = 1 To lngLen
strChar = Mid(strAddress, lngIndex, 1)
If Asc(strChar) < 65 Or Asc(strChar) > 90 Then
GetColIDByStr = 0
Exit Function
End If
lngColID = lngColID + (((Asc(strChar) - 65) Mod 26) + 1) * (26 ^ (lngLen - lngIndex))
Next
If lngColID > Columns.Count Then
GetColIDByStr = 0
Exit Function
End If
GetColIDByStr = lngColID
End Function
'根据表名返回工作表
Function GetShByName(strShName As String) As Worksheet
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = strShName Then
Set GetShByName = sh
Exit Function
End If
Next
Set GetShByName = Nothing
End Function

复制代码

玉阳山人 · 发表于 2019-11-11 20:40

本帖最后由玉阳山人于 2019-11-11 21:23 编辑

老师：列区域公式：
1.DTQY(5,22)外套MAX,MIN,AVERAGE,MODE,COUNT都能显示正确结果；但在输入=COUNTIF(DTQY(5,22),3)，发生#VALUE!错误。
2.输入第三、四参数时，必须前后加"引号，如=MAX(DTQY(5,22,"K","通用公式"))，才能显示正确结果；不加双引号，如=MAX(DTQY(5,22,K,通用公式))，否则就会显示#VALUE!错误？能不能修改成不加双引号，如=MAX(DTQY(5,22,K,通用公式))就能显示正确结果？
3.由于是统计计算，所以应该显示所有结果，不必设置不显示0。

行区域公式：=DTQY(J,Q)无论外套MAX,MIN,AVERAGE,MODE,COUNT哪个公式，怎么都显示#VALUE!错误？

玉阳山人 · 发表于 2019-11-12 07:54

顶起！千万别沉了！

lsdongjh · 发表于 2019-11-12 08:55

1、要有一些基本常识，字符型与数值型【DTQY("J","Q")】
2、原来考虑是简单的处理，返回的是数组，给你改为返回range对象

Option Explicit
Function DTQY(StartID As Variant, EndID As Variant, Optional RowOrColID As Variant = "", Optional shName As String = "") As Variant
Dim rgCur As Range, strRowOrColID As String, strSelType As String
Dim lngCurRow As Long, lngCurCol As Long
Dim SelRow_Start As Long, SelRow_End As Long
Dim SelCol_Start As Long, SelCol_End As Long
Dim SelSh As Worksheet, arrResult As Variant
'取得公式所在单元格的信息
Set rgCur = Application.Caller
lngCurRow = rgCur.Row
lngCurCol = rgCur.Column
'获取工作表
If Trim(shName) = "" Then
Set SelSh = rgCur.Worksheet
Else
Set SelSh = GetShByName(Trim(shName))
End If
If SelSh Is Nothing Then
DTQY = "表名不存在"
Exit Function
End If
'判断参数类型
If IsNumeric(StartID) Then
strSelType = "ROW"
Else
strSelType = "COL"
End If
'如果参数1与参数2类型不一致，退出
If IsNumeric(StartID) <> IsNumeric(EndID) Then
DTQY = "参数1、2类型不一致"
Exit Function
End If
'如果参数1、2的类型与参数3相同，退出
If RowOrColID <> "" And (IsNumeric(StartID) = IsNumeric(RowOrColID)) Then
DTQY = "参数3类型不对"
Exit Function
End If
'如果行号参数不对，退出
If IsNumeric(StartID) And (Val(StartID) < 1 Or Val(StartID) > Rows.Count) Then
DTQY = "参数1设置有误"
Exit Function
End If
If IsNumeric(EndID) And (Val(EndID) < 1 Or Val(EndID) > Rows.Count) Then
DTQY = "参数2设置有误"
Exit Function
End If
'设置第三参数
strRowOrColID = Trim(UCase(RowOrColID))
'根据传入的参数，设置区域参数
Select Case strSelType
Case "ROW" '设置参数为行号
SelRow_Start = Val(StartID) '起始行
SelRow_End = Val(EndID) '结束行
'根据第三参数获取列号
If strRowOrColID <> "" Then
lngCurCol = GetColIDByStr(strRowOrColID)
End If
'列号有误，退出
If lngCurCol = 0 Then
DTQY = "参数3设置有误"
Exit Function
End If
'返回选择区域
Set arrResult = SelSh.Range(SelSh.Cells(SelRow_Start, lngCurCol), SelSh.Cells(SelRow_End, lngCurCol))
Case "COL" '设置参数为列号
SelCol_Start = GetColIDByStr(CStr(StartID)) '起始列
SelCol_End = GetColIDByStr(CStr(EndID)) '结束列
If SelCol_Start * SelCol_End = 0 Then
DTQY = "参数1、2设置有误"
Exit Function
End If
'根据第三参数获取行号
If strRowOrColID <> "" Then
lngCurRow = Val(strRowOrColID)
End If
'行号有误，退出
If lngCurRow < 1 Or lngCurRow > Rows.Count Then
DTQY = "参数3设置有误"
Exit Function
End If
'返回选择区域
Set arrResult = SelSh.Range(SelSh.Cells(lngCurRow, SelCol_Start), SelSh.Cells(lngCurRow, SelCol_End))
End Select
'返回最终结果区域
Set DTQY = arrResult
End Function
'根据列名，返回列标索引
Function GetColIDByStr(strColName As String) As Long
Dim strAddress As String, lngLen As Long
Dim lngIndex As Long, strChar As String
Dim lngColID As Long
strAddress = Trim(UCase(strColName))
lngLen = Len(strAddress)
For lngIndex = 1 To lngLen
strChar = Mid(strAddress, lngIndex, 1)
If Asc(strChar) < 65 Or Asc(strChar) > 90 Then
GetColIDByStr = 0
Exit Function
End If
lngColID = lngColID + (((Asc(strChar) - 65) Mod 26) + 1) * (26 ^ (lngLen - lngIndex))
Next
If lngColID > Columns.Count Then
GetColIDByStr = 0
Exit Function
End If
GetColIDByStr = lngColID
End Function
'根据表名返回工作表
Function GetShByName(strShName As String) As Worksheet
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = strShName Then
Set GetShByName = sh
Exit Function
End If
Next
Set GetShByName = Nothing
End Function

复制代码

玉阳山人 · 发表于 2019-11-12 09:49

本帖最后由玉阳山人于 2019-11-12 09:53 编辑

lsdongjh 发表于 2019-11-12 08:55
1、要有一些基本常识，字符型与数值型【DTQY("J","Q")】
2、原来考虑是简单的处理，返回的是数组，给你 ...

老师：还有一点需要修改--由于是统计计算，所以应该显示所有结果，当计算结果为0时，应该显示0，不能设置为空白【L42:Q43里土黄色填充的空格应该显示0才对】。

修改了这一点，就尽善尽美了！

lsdongjh · 发表于 2019-11-12 09:51

玉阳山人发表于 2019-11-12 09:49
老师：
还有一点需要修改--由于是统计计算，所以应该显示所有结果，当计算结果为0时，应该显示 ...

又是一个基本常识：自带函数自己处理！

玉阳山人 · 发表于 2019-11-12 10:05

本帖最后由玉阳山人于 2019-11-12 10:08 编辑

lsdongjh 发表于 2019-11-12 09:51
又是一个基本常识：自带函数自己处理！

举例：如L42，求L$15:L$22的最小值，如果输入公式=MIN(L$15:L$22)，明显能看到计算结果为0；但当输入公式=MIN(DTQY(5,22))时，计算结果仍然为0，却被设置为不显示0值，想不通这是什么原因造成的？

玉阳山人 · 发表于 2019-11-12 10:20

lsdongjh 发表于 2019-11-12 09:51
又是一个基本常识：自带函数自己处理！

老师：委实想不明白为什么--输入常规公式=MIN(L$5:L$22) 能明显看到0，输入公式=MIN(DTQY(L$5:L$22))，其0值却不显示？

		自动登录	找回密码
密码			免费注册

[求助] 能够按指定行号、列标，动态扩展统计区域的内嵌自定义函数

评分

评分

评分

最新热点 /1