创建按第二参数指定的位置开始，向上或向下显示数据源非空数据的自定义函数

玉阳山人 · 发表于 2019-9-26 16:52

本帖最后由玉阳山人于 2019-9-27 16:07 编辑

从指定位置开始，显示所有非空数据.zip (8.44 KB, 下载次数: 7)

请老师们帮忙写个能够嵌套其它函数的自定义函数。每行代码后面最好加上详细说明。

microyip · 发表于 2019-9-26 17:06

你为何不直接找lsdongjh做你专门代工？联系不上吗？

玉阳山人 · 发表于 2019-9-26 19:43

请老师们帮忙写个自定义函数。每行代码后面最好加上详细说明。

玉阳山人 · 发表于 2019-9-26 23:50

请老师们帮忙写个自定义函数。每行代码后面最好加上详细说明。以便深入学习和掌握不同指定条件下数据显示位置的思路。

玉阳山人 · 发表于 2019-9-27 09:19

请老师们帮忙写个自定义函数。每行代码后面最好加上详细说明。以便深入学习和掌握不同指定条件下数据显示位置的诀窍方法。

玉阳山人 · 发表于 2019-9-27 13:57

请老师们帮忙写个自定义函数。每行代码后面最好加上详细说明。以便深入学习和掌握不同指定条件下数据显示位置的诀窍方法。

玉阳山人 · 发表于 2019-9-27 16:07

请老师们帮忙写个自定义函数。每行代码后面最好加上详细说明。以便深入学习和掌握不同指定条件下数据显示位置的诀窍方法。

lsdongjh · 发表于 2019-9-27 17:42

Option Explicit
Function SJTJTQ(rgSource As Range, lngStartRowID As Long) As Variant
Dim arrSource As Variant, arrResult As Variant, lngRow As Long
Dim rgCaller As Range, lngStartID As Long, lngMax As Long, lngEnd As Long
Dim strContent As String, strSplit() As String, lngStep As Long
Set rgCaller = Application.Caller
lngMax = rgCaller.Rows.Count '公式所在的总行数
ReDim arrResult(1 To lngMax, 1 To 1) As String
If rgSource.Columns.Count > 1 Then
arrResult(1, 1) = "数据区域只能是1列！"
SJTJTQ = arrResult
Exit Function
End If
If rgSource.Rows.Count > lngMax Then
arrResult(1, 1) = "公式区域小于数据区域！"
SJTJTQ = arrResult
Exit Function
End If
If rgSource(1).Row <> rgCaller(1).Row Then
arrResult(1, 1) = "公式与数据首行不对应！"
SJTJTQ = arrResult
Exit Function
End If
If lngStartRowID < 1 Then
arrResult(1, 1) = "指定行号错误"
SJTJTQ = arrResult
Exit Function
End If
If lngStartRowID > 2 Then
If lngStartRowID < rgSource(1).Row Or lngStartRowID > rgSource(1).Row + rgSource.Rows.Count - 1 Then
arrResult(1, 1) = "指定行号错误"
SJTJTQ = arrResult
Exit Function
End If
End If
Set rgCaller = Nothing
'判断数据的起始、结束行号
lngRow = rgSource(1).Row - 1
If Trim(rgSource(1).Value) <> "" Then
lngStartID = 1
Else
Set rgCaller = rgSource.Find("*", LookIn:=xlValues)
If rgCaller Is Nothing Then
arrResult(1, 1) = "无数据！"
SJTJTQ = arrResult
Exit Function
End If
lngStartID = rgSource.Find("*", LookIn:=xlValues).Row - lngRow
End If
lngEnd = rgSource.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row - lngRow
arrSource = rgSource
arrSource = Application.WorksheetFunction.Transpose(arrSource)
strContent = Application.WorksheetFunction.Trim(Join(arrSource, Space(1)))
strSplit = Split(strContent, Space(1))
Select Case lngStartRowID
Case 1 '顺排
For lngRow = LBound(strSplit) To UBound(strSplit)
arrResult(lngRow + lngStartID, 1) = strSplit(lngRow)
Next
Case 2 '逆排
For lngRow = UBound(strSplit) To LBound(strSplit) Step -1
arrResult(lngEnd, 1) = strSplit(lngRow)
lngEnd = lngEnd - 1
Next
Case Else '指定行号逆排
lngStartRowID = lngStartRowID - rgSource(1).Row + 1
For lngRow = UBound(strSplit) To LBound(strSplit) Step -1
arrResult(lngStartRowID, 1) = strSplit(lngRow)
lngStartRowID = lngStartRowID - 1
If lngStartRowID = 0 Then Exit For
Next
End Select
SJTJTQ = arrResult
End Function

复制代码

microyip · 发表于 2019-9-27 17:50

lsdongjh 发表于 2019-9-27 17:42

你提供个联系方式给道长啊，叫他直接找你啊，这样不用一天天的不停的自顶贴，等你的回复

lsdongjh · 发表于 2019-9-27 17:53

microyip 发表于 2019-9-27 17:50
你提供个联系方式给道长啊，叫他直接找你啊，这样不用一天天的不停的自顶贴，等你的回复

权当练习了

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

[求助] 创建按第二参数指定的位置开始，向上或向下显示数据源非空数据的自定义函数

评分

评分

评分

最新热点 /1