用VBA将这个改写成自定义函数 而且不能用goto语句

laoau123

用VBA将这个改写成自定义函数  而且不能用goto语句

fjmxwrs

不好意思，我没有看懂你的公式的意思，说说你的结果如何而来（公式的意思)?

laoau123

fjmxwrs 发表于 2016-8-20 19:35
不好意思，我没有看懂你的公式的意思，说说你的结果如何而来（公式的意思)?

用VBA将这个改写成自定义函数  而且不能用goto语句

例如:公式L8计算出J8与K8(即1与2)这两个数作为一组在(C:H列第8至第23行)一共出现多少次?
只要C8:H18这六个数中有1与2两个数就计一次.
在统计数据区C8:H23中,1和2同时出现一次就统计一次,最后结果求和保存在L8

SUB结果保存M列      将SUB改写成自定义函数结果保存N列

fjmxwrs

laoau123 发表于 2016-8-20 19:48
用VBA将这个改写成自定义函数  而且不能用goto语句

例如:公式L8计算出J8与K8(即1与2)这两个数作为一 ...

每一行同时有这两个数的行数是吗

laoau123

fjmxwrs 发表于 2016-8-20 19:51
每一行同时有这两个数的行数是吗

完全正确，一行同时含有这两个数        不过要用自定义函数

fjmxwrs

laoau123 发表于 2016-8-20 20:10
完全正确，一行同时含有这两个数        不过要用自定义函数

M列用的VBA直接得结果，和N列的自定义函数(第一个参数和第二个参数为那两个数，第三个参数为计算的单元格区域)
都没用goto

laoau123

fjmxwrs 发表于 2016-8-20 20:19
M列用的VBA直接得结果，和N列的自定义函数(第一个参数和第二个参数为那两个数，第三个参数为计算的单元格 ...

果然高手答案完全正确，还写了两种


Sub ss()
    Dim arr, brr, crr(), n1%, n2%, x%, y%, i%
    With Sheet2
        arr = .Range("C8:H" & .Range("H65536").End(xlUp).Row)
        brr = .Range("J8:K" & .Range("K65536").End(xlUp).Row)
        ReDim crr(1 To UBound(brr))
        For x = 1 To UBound(brr)
            crr(x) = 0
            For y = 1 To UBound(arr)
                For i = 1 To 6
                    If arr(y, i) = brr(x, 1) Then n1 = n1 + 1
                    If arr(y, i) = brr(x, 2) Then n2 = n2 + 1
                Next i
                If n1 > 0 And n2 > 0 Then
                    crr(x) = crr(x) + 1
                End If
                n1 = 0: n2 = 0
            Next y
        Next x
        .Range("M8").Resize(UBound(crr)) = Application.Transpose(crr)
        Erase arr, brr, crr
    End With
End Sub
Function mySUM(n1%, n2%, rng As Range)
    Dim arr, n%, i%, j%, x%, y%
    arr = rng
    For x = 1 To UBound(arr)
        For y = 1 To UBound(arr, 2)
            If arr(x, y) = n1 Then i = i + 1
            If arr(x, y) = n2 Then j = j + 1
        Next y
        If i > 0 And j > 0 Then n = n + 1
        i = 0: j = 0
    Next x
    mySUM = n
    Erase arr
End Function