|
|
楼主 |
发表于 2020-3-15 18:07
|
显示全部楼层
本帖最后由 玉阳山人 于 2020-3-15 21:53 编辑
能够自动刷新的动态区域.zip
(61.13 KB, 下载次数: 2)
代码如下：
Function DTQY(StartID As Variant, EndID As Variant, Optional RowOrColID As Variant = "", Optional shName As String = "", Optional intAll As Integer = 0) As Variant
Application.Volatile '声明为易失性函数
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
If intAll <> 0 Then SelRow_End = SelSh.Cells(SelRow_End, lngCurCol).End(xlUp).Row
'返回选择区域
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
If intAll <> 0 Then SelCol_End = SelSh.Cells(lngCurRow, SelCol_End).End(xlToLeft).Column
'返回选择区域
Set arrResult = SelSh.Range(SelSh.Cells(lngCurRow, SelCol_Start), SelSh.Cells(lngCurRow, SelCol_End))
End Select
'返回最终结果区域
Set DTQY = arrResult
End Function
'根据列名，返回列标索引
Private 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
'根据表名返回工作表
Private 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
曾经有老师写过上边的代码，验证时有个Bug，经过两天来的反复测试，终于找到了代码出错的原因：当实际上的数据区域，小于第2参数限定的指定范围时，计算的结果才会正确；而唯独只在 1. 数据区域=指定范围 2. 指定范围内没有数据 的情况下才会出错。
那么，1.只需再增加一个判断语句：当数据区域的最后行、列与参数2指定的范围相同时，则用指定范围代替数据区域，进行统计计算就行了吧？ 如：T5:T22中指定范围是DTQY("J","Q",,,1），代表对J:Q列里的各行数据进行统计，从上图看出，指定范围的最后一列Q5:Q22里，哪一行若没有数据，则T5:T22的哪一行计算结果就正确；哪一行有数据，T5:T22的哪一行计算结果就不对。
模块1的代码里，If intAll <> 0 Then SelRow_End = SelSh.Cells(SelRow_End, lngCurCol).End(xlUp).Row 这一句好像是代表最后数据行；而 If intAll <> 0 Then SelCol_End = SelSh.Cells(lngCurRow, SelCol_End).End(xlToLeft).Column 则是代表最后数据列；
麻烦老师们在这两句后面，各增加一句判断代码---当指定范围内尚没有任何数据；或者数据区域正好等于指定范围时，则用指定范围代替数据区域进行统计计算，这样就能保证计算结果始终正确了！
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-3-14 09:24
