EXCEL VBA FUNCTION自定义函数，高分求助，高手来帮忙！

高分求4个VBA FUNCTION自定义函数的编写方法以，请网上的老师来帮忙！

如图，A列是原始数据，A列的每个单元格中，有的单元格里只有一行文本，有的单元格里有多行文本。
有多行文本的单元格，每行以自动换行符CHAR(10)分开。
求：
1、自定义函数sDate，从A1中第14个字符开始，向后提5个字符，得到19DEC(日期和月份），将此日期加上年份，格式为"YYYY-MM-DD"，如单元格中有多行，每行都需要提出。

2、 自定义函数sNum，提出A列单元格中前6个字符，如单元格中有多行，每行都需要提出。

3、自定义函数dTime，从A1中第34个字符开始，向后提4个字符，并将中单加上冒号，如单元格中有多行，每行都需要提出。

4、自定义函数aTime，从A1中第39个字符开始，向后提4个字符，并将中单加上冒号，如单元格中有多行，每行都需要提出。

>> Q1★sDate

Public Function sDate(ByVal Target As Range) As String
    sDate = Format$(Evaluate("=DATEVALUE(MID(" & Target.Address(False, True) & ",14,5))"), "yyyy-MM-dd")
End Function

>> Q2★sNum

Public Function sNum(ByVal Target As Range) As String
    sNum = Evaluate("=LEFT(" & Target.Address(False, True) & ",6)")
End Function

>> Q3★dTime

Public Function dTime(ByVal Target As Range) As String
    dTime = Format$(Evaluate("=MID(" & Target.Address(False, True) & ",34,4)"), "00:00")
End Function

>> Q4★aTime

Public Function aTime(ByVal Target As Range) As String
    aTime = Format$(Evaluate("=MID(" & Target.Address(False, True) & ",39,4)"), "00:00")
End Function

 

PS：使用方法和 Excel 自带函数一样，输入完一个单元格后下拉即可！

追问

谢谢大侠，但第一个sDate能否帮忙改下，如下图只能显示一行的日期

追答Public Function sDate(ByVal Target As Range) As String
    Dim varResult As Variant
    
    varResult = Split(Target.Value, vbLf)
    
    Dim lngIndex As Long
    
    For lngIndex = LBound(varResult) To UBound(varResult)
        sDate = sDate & Format$(Evaluate("=DATEVALUE(MID(""" & varResult(lngIndex) & """,14,5))"), "yyyy-MM-dd") & vbLf
    Next
    
    sDate = Left$(sDate, Len(sDate) - 1)
End Function

注意：如果公式返回的结果不自动换行，请自行设置单元格→自动换行！！！

运行结果：

追问

sDate没问题了，由于可能每行数据不同，我照猫画虎更改了sNum，但不成功，还有dTime aTime怎么改，还烦请大侠赐教，辛苦了！！！！

追答

注意依葫芦画瓢时别遗漏，这里我再提供一个 sNum，其他希望你可以自行完成修改：

Public Function sNum(ByVal Target As Range) As String
    Dim varResult As Variant
     
    varResult = Split(Target.Value, vbLf)
     
    Dim lngIndex As Long
     
    For lngIndex = LBound(varResult) To UBound(varResult)
        sNum = sNum & Evaluate("=LEFT(" & Target.Address(False, True) & ",6)") & vbLf
    Next
    
    sNum = Left$(sNum, Len(sNum) - 1)
End Function

你的语句中遗漏了对 sNum 的自身拼接☺：

        sNum = Evaluate("=LEFT(" & Target.Address(False, True) & ",6)") & vbL

追问

大侠，不变呀？？

追答

Sorry，请改成这样（其他的自定义函数也做同样的修改）：

Public Function sNum(ByVal Target As Range) As String
    Dim varResult As Variant
      
    varResult = Split(Target.Value, vbLf)
      
    Dim lngIndex As Long
      
    For lngIndex = LBound(varResult) To UBound(varResult)
        sNum = sNum & Evaluate("=LEFT(""" & varResult(lngIndex) & """,6)") & vbLf
    Next
     
    sNum = Left$(sNum, Len(sNum) - 1)
End Function

注意把循环之间的代码行中的 Target.Address(False, True) 替换成 varResult(lngIndex) 并且在两边各加两个双引号！

温馨提示：内容为网友见解，仅供参考

当前网址：https://11.t2y.org/zz/2pqf4qmf7pqf48m772.html