对两个去重升序自定义函数的代码取长补短

WYS67 · 发表于 2019-4-12 13:09

本帖最后由 WYS67 于 2019-4-12 13:09 编辑

表一里是两个去重升序的自定义函数的代码：1.QCSX的代码，运算速度快，但面对文本类数字，就会发生#VALUE!错误；2.而QCSXS的代码，可以对文本类数字去重升序，但在表二的C5:C40000输入{ =QCSXS(A5:A40000)后，老是提示“无响应”，不显示计算结果--

求解决方案.zip (703.8 KB, 下载次数: 7)

恳请高手大神们以QCSX【运算速度快】为蓝本，修改代码，使其在表二里输入{ =QCSX(A5:A40000)时，则显示如B列计算结果；输入{ =QCSX($E$5:$E$60)时，即可显示如G列计算结果，不再发生#VALUE!错误。

不知道为什么 · 发表于 2019-4-12 13:32

大师，我帮你顶下啊。呵呵

WYS67 · 发表于 2019-4-12 13:42

不知道为什么发表于 2019-4-12 13:32
大师，我帮你顶下啊。呵呵

谢谢老师帮顶！但一句“大师”让我惭愧无比！

microyip · 发表于 2019-4-12 13:49

大神，我帮你顶下啊。呵呵

WYS67 · 发表于 2019-4-12 14:56

恳请老师们帮忙解决A列代码计算结果显示#VALUE!错误的问题！

lsdongjh · 发表于 2019-4-12 15:17

If Not arraylist.contains(CStr(r)) Then arraylist.Add CStr(r)

复制代码

WYS67 · 发表于 2019-4-12 15:26

lsdongjh 发表于 2019-4-12 15:17

老师：需要加在下面代码的哪个地方？

Function QCSX(sjy As Range)
Application.Volatile
      Dim arraylist As Object, arr, x, y, r
      arr = sjy
      Set arraylist = CreateObject("system.collections.arraylist")
      For Each r In arr
         If Not (IsError(r)) Then
         If r <> "" Then
         If Not arraylist.contains(r) Then arraylist.Add r
         End If
         End If
      Next
      arraylist.Sort
x = arraylist.toarray
Set arraylist = Nothing

ReDim y(1 To UBound(arr), 1 To 1)
For i = 0 To UBound(x)
      y(i + 1, 1) = x(i)
Next
For i = UBound(x) + 2 To UBound(arr)
      y(i, 1) = ""
Next
QCSX = y
End Function

lsdongjh · 发表于 2019-4-12 15:28

出错的原因是类型转换有问题，所以强制转成文本，修改原来的这句：If Not arraylist.contains(r) Then arraylist.Add r

改为 If Not arraylist.contains(CStr(r)) Then arraylist.Add CStr(r)

WYS67 · 发表于 2019-4-12 15:38

lsdongjh 发表于 2019-4-12 15:28
出错的原因是类型转换有问题，所以强制转成文本，修改原来的这句：If Not arraylist.contains(r) Then arra ...

经测试，您修改的代码，输入公式后，完全可以显示正确结果。谢谢老师！

WYS67 · 发表于 2019-4-12 17:29

lsdongjh 发表于 2019-4-12 15:28
出错的原因是类型转换有问题，所以强制转成文本，修改原来的这句：If Not arraylist.contains(r) Then arra ...

奇怪：如下面附件里《问题》的D列所示，QCSX自定义函数只能去重，却没有完全按照小大顺序升序显示。

求解决方案.zip (1.73 MB, 下载次数: 5)

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

[求助] 对两个去重升序自定义函数的代码取长补短

评分

评分

评分

评分

最新热点 /1