自定义函数--提取单元格内多个被分开的数字

WYS67

YZC51 发表于 2020-3-13 11:42
您好！请参考391楼！

老师请看截图：1.因为没有对应的第4个字符，所以返回结果为空白！所以，应该默认为精确查找；比如A列没有5，但=查找行列($C$5,$A$5:$A$100,$D5,E$4)，却显示$A$15,而$A$15是45；同样A列里本没有3，但C5指定为3后，却显示有5个3，实际上A12是31，A13是36，A14是43，A27是73，A40是113......这个问题还没有解决。

2.找不到数据时，已不再显示#VALUE!  ，这个问题已解决。

YZC51

WYS67 发表于 2020-3-13 11:52
老师请看截图：1.因为没有对应的第4个字符，所以返回结果为空白！所以，应该默认为精确查找；比如A列 ...

试试
'        If InStr(s, sr) Then
修改为
        If s = sr Then

玉阳山人

YZC51 发表于 2020-3-13 12:39
试试
'        If InStr(s, sr) Then
修改为

这次算是 精确查找了！功能很强大！谢谢老师！

YZC51

玉阳山人 发表于 2020-3-13 12:52
这次算是 精确查找了！功能很强大！谢谢老师！

不客气，解决问题就好！

WYS67

YZC51 发表于 2020-3-13 12:55
不客气，解决问题就好！

Function 查找行列(sr, rng As Range, Optional x As Integer, Optional y As Integer)
   '  y=  0、默认，单元格绝对引用；1、查找列；2、查找行；3、单元格相对引用
    Dim d As Object, arr, brr, v, xd, n%
    arr = rng
    Set d = CreateObject("Scripting.Dictionary")
    For Each s In arr
        d(i) = ""
    Next
    brr = d.keys
    n = UBound(brr)
    For Each s In rng
        If s = sr Then '为精确查找
         'If InStr(s, sr) Then 为模糊查找
            n = n + 1
            ReDim Preserve brr(0 To n)
            brr(n) = s.Address
        End If
    Next
    If Abs(x) > UBound(brr) Then 查找行列 = "": Exit Function
    If x < 0 Then x = UBound(brr) + x + 1
    v = Split(brr(x), "$")
    查找行列 = Choose(y + 1, brr(x), v(1), v(2), v(1) & v(2))
End Function

老师：怎样编写 当第三参数【查找顺序】为空时，让计算结果返回返回空白？

YZC51

试试
Function 查找行列(sr, rng As Range, Optional x As Integer, Optional y As Integer)
   If len(x) =0 Then 查找行列 = "": Exit Function

WYS67

YZC51 发表于 2020-3-13 13:31
试试
Function 查找行列(sr, rng As Range, Optional x As Integer, Optional y As Integer)
   If len( ...

改成  If len(x) =0 Then 查找行列 = "": Exit Function  后，仍然显示#VALUE!错误。

这个问题还不算是太重要，我只是跟您学习处理意外情况的方法和技巧。

我把函数名称查找行列改成CZWZ【输入时方便！】后，发现当没有符合条件的数据时，原先的空白都变成了0.这个问题怎么解决？

YZC51

WYS67 发表于 2020-3-13 14:07
改成  If len(x) =0 Then 查找行列 = "": Exit Function  后，仍然显示#VALUE!错误。

这个问题还不算 ...

贴出代码看看才能知道的

WYS67

YZC51 发表于 2020-3-13 14:26
贴出代码看看才能知道的

Function CZWZ(sr, rng As Range, Optional x As Integer, Optional y As Integer)
   If Len(x) = 0 Then 查找行列 = "": Exit Function
   '  y=  0、默认，单元格绝对引用；1、查找列；2、查找行；3、单元格相对引用
    Dim d As Object, arr, brr, v, xd, n%
    arr = rng
    Set d = CreateObject("Scripting.Dictionary")
    For Each s In arr
        d(i) = ""
    Next
    brr = d.keys
    n = UBound(brr)
    For Each s In rng
        If s = sr Then '为精确查找
        'If InStr(s, sr) Then 为模糊查找
            n = n + 1
            ReDim Preserve brr(0 To n)
            brr(n) = s.Address
        End If
    Next
    If Abs(x) > UBound(brr) Then 查找行列 = "": Exit Function
    If x < 0 Then x = UBound(brr) + x + 1
    v = Split(brr(x), "$")
    CZWZ = Choose(y + 1, brr(x), v(1), v(2), v(1) & v(2))
End Function


只是把查找行列改成了CZWZ，其它地方都没动。

WYS67

YZC51 发表于 2020-3-13 14:26
贴出代码看看才能知道的

把代码里的两处CZWZ恢复成查找行列后，多出的0就又变成空白了。

怪哉！以前从没有遇到过此类问题。