ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: 小花鹿

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

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-1 13:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 小花鹿 于 2019-2-1 22:05 编辑
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

TA的精华主题

TA的得分主题

发表于 2019-2-2 11:40 | 显示全部楼层
本帖最后由 yjh_27 于 2019-2-2 16:24 编辑
小花鹿 发表于 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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-6 21:44 | 显示全部楼层
本帖最后由 小花鹿 于 2019-2-21 07:39 编辑

=============================================================
修改一下,可以求行号和列号,有兴趣的帮忙测试一下:
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

TA的精华主题

TA的得分主题

发表于 2019-5-4 08:49 | 显示全部楼层

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


TA的精华主题

TA的得分主题

发表于 2019-5-4 09:23 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
编辑帖子引起的,匆略。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-5-4 09:34 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-6-7 08:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

TA的精华主题

TA的得分主题

发表于 2019-6-7 11:21 | 显示全部楼层
小花鹿 发表于 2019-2-6 21:44
=============================================================
修改一下,可以求行号和列号,有兴趣的 ...

怎样输入公式?

TA的精华主题

TA的得分主题

发表于 2019-6-7 14:36 | 显示全部楼层
本帖最后由 yjh_27 于 2019-6-7 14:42 编辑
WYS67 发表于 2019-6-7 08:26
老师:输入公式  =ENDRC(A:H,1)  ,求A:H列的最后行号,显示#VALUE!错误。什么原因?
A:H
工作表名   1  的工作表末找到

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-6-8 00:19 | 显示全部楼层
本帖最后由 WYS67 于 2019-6-8 01:55 编辑
yjh_27 发表于 2019-6-7 14:36
“A:H”
工作表名   1  的工作表末找到

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

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

公式不能写在参数1所在的区域内!
谢谢老师!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 02:31 , Processed in 0.046304 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表