|
|
Function DataRC(Optional mode = 6, Optional MyRange As String, Optional MySht As String, Optional R1 = 0, Optional C1 = 0, Optional Rs = 0, Optional Cs = 0)
'得到有数据的最后(最前)行列号，三个参数均可选
'参数形式如：MyRange 指定范围,如果忽略则为UsedRange
' "A:B" 整列
' "6:26" 整行
' "a6:h26" 矩形区域
' "-1" 负数，函数范围caller
' "" UsedRange
' MySht 指工作表名，如果忽略则为活动工作表
' 在工作表中使用且MySht=活动工作表时，会引起循环引用，需设置手动计算Application.Calculation = xlManual或启用迭代计算Application.Iteration = True
'
' mode 返回模式,
' >0 1~9最大行（行扫描优先），>9最大列（列扫描优先）
' <0 -1~-9最小行（行扫描优先），<-9最小列（列扫描优先）
' 1 最大行号
' 2 最大行号对应最后列号
' 3 最大行号对应最后列字母
' 4 "最大行号,对应最后列号"
' 5 最大行最后列绝对地址
' 6 最大行最后列相对地址(默认)
' 7 "最大行号,最大列号"
' 8 最大行列绝对地址
' 9 最大行列相对地址
' 11 最大列号最前行号
' 12 最大列号
' 13 最大列字母
' 14 "对应最前行号,最大列号"
' 15 最大列对应最前行绝对地址
' 16 最大列对应最前行相对地址
' 17 "最大行号,最大列号"
' 18 最大行列绝对地址
' 19 最大行列相对地址
' -1 最小行号
' -2 最小行号对应最前列号
' -3 最小行号对应最前列字母
' -4 "最小行号,对应最前列号"
' -5 最小行对应最前列绝对地址
' -6 最小行对应最前列相对地址
' -7 "最小行号,最小列号"
' -8 最小行列绝对地址
' -9 最小行列相对地址
' -11 最小列号最前行号
' -12 最小列号
' -13 最小列字母
' -14 "对应最前行号,最小列号"
' -15 最小列对应最前行绝对地址
' -16 最小列对应最前行相对地址
' -17 "最小行号,最小列号"
' -18 最小行列绝对地址
' -19 最小行列相对地址
Dim rng As Range, sht As Worksheet, ar, i As Long, j As Long
If MySht <> "" Then Set sht = Sheets(MySht) Else Set sht = ActiveSheet
If MyRange = "" Then
Set rng1 = sht.UsedRange
ElseIf Val(MyRange) < 0 Then
Set rng1 = Application.Caller
Else
Set rng1 = sht.Range(MyRange)
End If
If Rs * Cs > 0 Then
Set rng = rng1.Offset(R1, C1).Resize(Rs, Cs)
ElseIf Rs > 0 Then
Set rng = rng1.Offset(R1, C1).Resize(Rs)
ElseIf Rs > 0 Then
Set rng = rng1.Offset(R1, C1).Resize(, Cs)
Else
Set rng = rng1.Offset(R1, C1)
End If
Set rng = Intersect(sht.UsedRange, rng)
If Not rng Is Nothing Then
If rng.Count = 1 Then
If Not IsEmpty(rng.Cells(1, 1)) Then EndR = rng.Row: EndC = rng.Column
ElseIf Abs(mode) Mod 10 > 6 Then
Rmax = rng.Row
Cmax = rng.Column
Rmin = rng.Row + rng.Rows.Count - 1
Cmin = rng.Column + rng.Columns.Count - 1
For Each rg In rng
If Not IsEmpty(rg) Then
If Rmax < rg.Row Then Rmax = rg.Row
If Cmax < rg.Column Then Cmax = rg.Column
If Rmin > rg.Row Then Rmin = rg.Row
If Cmin > rg.Column Then Cmin = rg.Column
End If
Next
If mode >= 0 Then
EndR = Rmax
EndC = Cmax
Else
EndR = Rmin
EndC = Cmin
End If
ElseIf mode < -10 Then
For j = 1 To rng.Columns.Count
For i = 1 To rng.Rows.Count
If Not IsEmpty(rng.Cells(i, j)) Then
EndR = rng.Cells(i, j).Row
EndC = rng.Cells(i, j).Column
j = rng.Columns.Count
Exit For
End If
Next
Next
ElseIf mode < 0 Then
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
If Not IsEmpty(rng.Cells(i, j)) Then
EndR = rng.Cells(i, j).Row
EndC = rng.Cells(i, j).Column
i = rng.Rows.Count
Exit For
End If
Next
Next
ElseIf mode < 10 Then
For i = rng.Rows.Count To 1 Step -1
For j = rng.Columns.Count To 1 Step -1
If Not IsEmpty(rng.Cells(i, j)) Then
EndR = rng.Cells(i, j).Row
EndC = rng.Cells(i, j).Column
i = 1
Exit For
End If
Next
Next
Else
For j = rng.Columns.Count To 1 Step -1
For i = rng.Rows.Count To 1 Step -1
If Not IsEmpty(rng.Cells(i, j)) Then
EndR = rng.Cells(i, j).Row
EndC = rng.Cells(i, j).Column
j = 1
Exit For
End If
Next
Next
End If
mode = Abs(mode) Mod 10
If mode > 6 Then mode = mode - 3
If mode = 1 Then
DataRC = EndR
ElseIf mode = 2 Then
DataRC = EndC
ElseIf mode = 3 Then
DataRC = Split(Cells(EndR, EndC).Address, "$")(1)
ElseIf mode = 4 Then
DataRC = EndR & "," & EndC
ElseIf mode = 5 Then
DataRC = Cells(EndR, EndC).Address
Else
DataRC = Cells(EndR, EndC).Address(0, 0)
End If
End If
End Function
老师：麻烦您给DATARC在合适的地方增加一句代码：当指定范围内没有数据存在时，使计算结果显示为空白？
|
|
楼主: yjh_27
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-3-13 11:30
楼主
