万能取有数据最后行号自定义函数(VBA专用)

小花鹿

zopey 发表于 2019-1-31 23:10
赋值给数组，应该可以

谢谢，我把它改成自定义函数，使用方便：
Sub test2()
MsgBox EndRow("a:b", "sheet2")
End Sub
Function EndRow(Optional myc As String, Optional mysht As String)
    '得到有数据的最后行号，两个参数均可选
    '参数形式如：myc是列范围，如"A:B",如果忽略则为整个工作表
    '            mysht是指工作表，如"sheet1"，如果忽略则为活动工作表
    Dim rng As Range, sht As Worksheet, ar, i&, j&
    If mysht <> "" Then
        Set sht = Sheets(mysht)
    Else
        Set sht = ActiveSheet
    End If
    If myc = "" Then
        Set rng = sht.UsedRange
    Else
        Set rng = Intersect(sht.UsedRange, sht.Range(myc))
    End If
    If rng Is Nothing Then
        EndRow = 0
        Exit Function
    End If
    ar = rng.Value
    If Not IsArray(ar) Then
        If Len(ar) = 0 Then
            EndRow = 0
            Exit Function
        Else
            EndRow = rng.Row
            Exit Function
        End If
    Else
        For i = UBound(ar) To 1 Step -1
            For j = 1 To UBound(ar, 2)
                If Len(ar(i, j)) Then
                    EndRow = i - 1 + rng.Row
                    Exit Function
                End If
            Next j
        Next i
    End If
    EndRow = 0
End Function

yjh_27

小花鹿 发表于 2019-2-1 13:26
谢谢，我把它改成自定义函数，使用方便：
Sub test2()
MsgBox EndRow("a:b", "sheet2")

1. Function EndRC(Optional myc As String, Optional mysht As String, Optional mode = 1) As Long
   
2.     '得到有数据的最后行号，两个参数均可选
   
3.     '参数形式如：myc是列范围，如"A:B",如果忽略则为整个工作表
   
4.     '            mysht是指工作表，如"sheet1"，如果忽略则为活动工作表
   
5.     '                 (在工作表中使用且mysht=活动工作表时，会引起循环引用，需设置手动计算Application.Calculation = xlManual或启用迭代计算Application.Iteration = True)
   
6.     '            mode 1最后行号,2最后列号
   
7.     Dim rng As Range, sht As Worksheet, ar, i&, j&, yuan As Boolean
   
8.     If mysht <> "" Then Set sht = Sheets(mysht) Else Set sht = ActiveSheet
   
9.     If myc = "" Then Set rng = sht.UsedRange Else Set rng = Intersect(sht.UsedRange, sht.Range(myc))
   
10.     If Not rng Is Nothing Then
    
11.         ar = rng.Value
    
12.         If Not IsArray(ar) Then
    
13.             If Len(ar) > 0 Then If mode = 1 Then EndRC = rng.Row Else EndRC = rng.Column
    
14.         Else
    
15.             For i = UBound(ar) To 1 Step -1
    
16.                 For j = UBound(ar, 2) To 1 Step -1
    
17.                     If Len(ar(i, j)) Then
    
18.                         If mode = 1 Then EndRC = i - 1 + rng.Row Else EndRC = j - 1 + rng.Column
    
19.                         i = 1
    
20.                         Exit For
    
21.                     End If
    
22.                 Next j
    
23.             Next i
    
24.         End If
    
25.     End If
    
26. End Function

复制代码

1. <blockquote>Function EndRC(Optional myc As String, Optional mysht As String, Optional mode = 1) As Long

复制代码

小花鹿

=============================================================
修改一下，可以求行号和列号，有兴趣的帮忙测试一下：
Sub test2()
Dim s1$, s2$, s
s1 = [m1]
s2 = [m2]
s = EndRC(s1, s2)
MsgBox s(1) & "," & s(2)
End Sub
Function EndRC(Optional MyRange As String, Optional MySht As String)
    '函数返回结果为两个元素的一维数组，EndRC(1)代表最后行号，EndRC(2)代表最后列号
    '得到指定范围的有数据的最后行列号，两个参数均可选
    '参数形式如：MyRange是指定范围，形如，整列"A:B"、整行"6:26"、矩形区域"a6:h26",如果忽略则为UsedRange
    '            MySht是指工作表，如"sheet1"，如果忽略则为活动工作表
    Dim rng As Range, sht As Worksheet, ar, i&, j&, RC(1 To 2) As Long
    If MySht <> "" Then
        Set sht = Sheets(MySht)
    Else
        Set sht = ActiveSheet
    End If
    If MyRange = "" Then
        Set rng = sht.UsedRange
    Else
        Set rng = Intersect(sht.UsedRange, sht.Range(MyRange))
    End If
    If rng Is Nothing Then
        GoTo label1
    End If
    ar = rng.Value
    If Not IsArray(ar) Then
        If Len(ar) = 0 Then
            GoTo label1
        Else
            RC(1) = rng.Row
            RC(2) = rng.Column
            GoTo label1
        End If
    Else
        For i = UBound(ar, 2) To 1 Step -1
            For j = 1 To UBound(ar)
                If Len(ar(j, i)) Then
                    RC(2) = i - 1 + rng.Column
                    GoTo label2
                End If
            Next j
        Next i
label2:
        For i = UBound(ar) To 1 Step -1
            For j = 1 To UBound(ar, 2)
                If Len(ar(i, j)) Then
                    RC(1) = i - 1 + rng.Row
                    GoTo label1
                End If
            Next j
        Next i
    End If
label1:
    EndRC = RC
End Function

WYS67

yjh_27 发表于 2019-2-2 11:40

老师：
<blockquote>Function EndRC(Optional myc As String, Optional mysht As String, Optional mode = 1) As Long
是什么意思？

yjh_27

编辑帖子引起的，匆略。

WYS67

yjh_27 发表于 2019-5-4 09:23
编辑帖子引起的，匆略。

感谢老师给予解疑释惑。

WYS67

yjh_27 发表于 2019-2-2 11:40

老师：输入公式  =ENDRC(A:H,1)  ，求A:H列的最后行号，显示#VALUE!错误。什么原因？

WYS67

小花鹿 发表于 2019-2-6 21:44
=============================================================
修改一下，可以求行号和列号，有兴趣的 ...

怎样输入公式？

yjh_27

WYS67 发表于 2019-6-7 08:26
老师：输入公式  =ENDRC(A:H,1)  ，求A:H列的最后行号，显示#VALUE!错误。什么原因？

“A:H”
工作表名   1  的工作表末找到

WYS67

yjh_27 发表于 2019-6-7 14:36
“A:H”
工作表名   1  的工作表末找到

最后行号   =ENDRC("A1:Z100","工作表名",1)

最后列标   =ENDRC("1:100","工作表名",2)

公式不能写在参数1所在的区域内！
谢谢老师！