为C列自定义函数的代码运算提速

YZC51

m = Cells(n, 2).End(3).Row - 4    我让C2维持原状，把数据源改为A列，计算列改为B列,没有改动m = Cells(n, 2).End(3).Row - 4  里边的2
因为下面这句把错误修正了
    If m < 5 Then m = n - 4

或者B列没有清空！                           

YZC51

13782671637 发表于 2018-6-18 21:18
m = Cells(n, 2).End(3).Row - 4    是不是不需要修改里边的2？

理论上应该修正！

13782671637

YZC51 发表于 2018-6-18 22:00
理论上应该修正！

老师：反复测试了好几遍，好像不修正并不影响计算结果的正确与否。

YZC51

请参考
为C列自定义函数的代码计算提速-1.2.rar (603.72 KB, 下载次数: 5)

2018-6-23 22:14 上传

点击文件名下载附件

13782671637

YZC51 发表于 2018-6-23 22:14
请参考

老师：我想说的是 为C列自定义函数的代码计算提速-1.zip (1.05 MB, 下载次数: 5)

2018-6-23 23:12 上传

点击文件名下载附件

这个附件。把点击按钮后弹出的文本框设计成N10:S10或P15:Q17的输入方式。         第一次点击“按钮1”，弹出文本框；1.输入指定内容后，再次点击“按钮1”，执行运算并显示计算结果；

                                                           2.如果要设定上次输入的指定内容为默认，可直接点击“按钮1”，就会立即执行运算并显示计算结果。


     http://club.excelhome.net/forum. ... 664&pid=9561146   14楼的代码占用了A3:F4极其宝贵的表头空间，还影响美观。希望按上面的写法修改一下代码。多谢了！

YZC51

请参考
Sub Zopey()
    Dim brr(), sr()
    n = [C2]
    If Len([Q10]) = 0 Then x1 = UCase(InputBox("请输入数据列名称")): [Q10] = x1: x = Asc(x1) - 64 Else x = Asc([Q10]) - 64
    If Len([S10]) = 0 Then y1 = UCase(InputBox("请输入输出列名称")): [S10] = y1: y = Asc(y1) - 64 Else y = Asc([S10]) - 64
    If Len(n) = 0 Then n = InputBox("请输入数据最大行"): [C2] = n
    Z = 5
'    m = Cells(Rows.Count, 1).End(3).Row - 4
    m = Cells(n, x).End(3).Row - 4
    If m < 5 Then m = n - 4
    Cells(n, y).Resize(m) = ""
   
    MsgBox "开始计算..."

    tms = Timer
    Columns(y).NumberFormatLocal = "@"
    m = Cells(Rows.Count, x).End(3).Row - Z + 1
    Cells(Z, y).Resize(100) = ""
    ar = Cells(Z, x).Resize(m)
    ReDim sr(1 To m, 1 To 1)
    ReDim brr(0 To 2)
    For I = 1 To m
        t = ar(I, 1): t1 = Left(t, 1)
        brr(t1) = brr(t1) + 1: If brr(t1) = 1 Then k1 = k1 + 1
        If k1 = 2 Then k1 = I: Exit For
    Next
    s1 = 3 - Left(ar(1, 1), 1) - Left(ar(k1, 1), 1)
    ReDim brr(0 To 2)
    For I = 1 To m
        t = ar(I, 1):  t2 = Right(t, 1)
        brr(t2) = brr(t2) + 1: If brr(t2) = 1 Then k2 = k2 + 1
        If k2 = 2 Then k2 = I: Exit For
    Next
    s2 = 3 - Right(ar(1, 1), 1) - Right(ar(k2, 1), 1)
    s = s1 & s2
    If k1 > k2 Then k0 = k1 Else k0 = k2
    For I = k0 To m
        t = ar(I - 1, 1): t11 = Left(t, 1): t12 = Right(t, 1)
        t = ar(I, 1): t21 = Left(t, 1): t22 = Right(t, 1)
        On Error GoTo JS

        If t11 = t21 Then s1 = Left(s, 1) Else s1 = 3 - t11 - t21
        If t12 = t22 Then s2 = Right(s, 1) Else s2 = 3 - t12 - t22
        s = s1 & s2
        sr(I, 1) = s
    Next
JS:
    Cells(Z, y).Resize(m - 1) = sr
    MsgBox Format(Timer - tms, "0.000s")
End Sub

13782671637

YZC51 发表于 2018-6-24 01:12
请参考
    Dim brr(), sr()
    n = [C2]

老师：请看截图

YZC51

13782671637 发表于 2018-6-24 02:42
老师：请看截图

请参考附件

YZC51

请参考附件
为代码计算提速-2.2.rar (544.77 KB, 下载次数: 6)

2018-6-24 09:36 上传

点击文件名下载附件

13782671637

YZC51 发表于 2018-6-24 08:45
请参考附件

老师：109楼附件点击按钮时出现问题。