根据用户自定义函数创建VBA功能

时间:2016-05-25 10:17:05

标签: excel vba excel-vba

感谢所有帮助我解决问题的朋友how to calculate specific cells in excel

现在,我需要帮助来编写VBA中的excel函数 功能是:=SUM(IFERROR(VALUE(IF(LEN(H27:Q27)=4,IF(ISNUMBER(SEARCH("b",LEFT(H27:Q27,2))),RIGHT(H27:Q27,1),LEFT(H27:Q27,1)),H27:Q27)),0))

提前致谢

2 个答案:

答案 0 :(得分:1)

我认为这个函数实现了公式。如果没有单元格中的原始数据集,则很难进行测试。请注意,该函数是从下面的Foo子例程调用的 - 因此您可以将可变范围传递给函数。希望有所帮助。

Function DoIt(rng As Range)
    ' VBA implementation for
    '=SUM(IFERROR(VALUE(IF(LEN(H27:Q27)=4,IF(ISNUMBER(SEARCH("b",LEFT(H27:Q27,2))),RIGHT(H27:Q27,1),LEFT(H27:Q27,1)),H27:Q27)),0))

    Dim dblResult As Double
    Dim rngCell As Range
    Dim intLength As Integer
    Dim strFragment1 As String
    Dim strFragment2 As String
    Dim intPos As Integer

    'set result
    dblResult = 0

    'loop for the array formula
    For Each rngCell In rngTarget

        'check value length = 4
        intLength = Len(rngCell.Value)
        If intLength = 4 Then
            'get bit of string and check for 'b' in string
            strFragment1 = Left(rngCell.Value, 2)
            'search for location of b in cell - use InStr for SEARCH
            intPos = InStr(1, strFragment, "b", vbBinaryCompare)
            If intPos <> 0 Then
                'b in fragment
                strFragment2 = Right(rngCell.Value, 1)
            Else
                'b not in fragment
                strFragment2 = Left(rngCell.Value, 1)
            End If

            '2nd fragment should be a number?  use IsNumeric for ISNUMBER and Val for VALUE
            If IsNumeric(strFragment2) Then
                dblResult = dblResult + Val(strResult)
            End If

        Else
            'cell value length <> 4
            'add cell value to result if is numeric - use IsNumeric for ISNUMBER and Val for VALUE
            If IsNumeric(rngCell.Value) Then
                dblResult = dblResult + Val(rngCell.Value)
            End If

        End If
    'next cell
    Next rngCell

    'return sum
    DoIt = dblResult

End Function

Sub Foo()
    Dim rngTarget As Range

    Set rng = Sheet1.Range("H27:Q27")

    Debug.Print DoIt(rng)

End Sub

答案 1 :(得分:1)

你走了:

Public Function GetTotal(rng As Range) As Long
    Dim tot As Long
    Dim celString As String
    Dim t1String As String, t2String As String

    For Each cel In rng
        If IsNumeric(cel) Then
            tot = tot + cel.Value
        ElseIf Len(cel.Value) = 4 Then
            celString = cel.Value
            t1String = Left(celString, 2)
            If InStr(1, t1String, "b") = 0 Then
                t2String = Left(celString, 1)
            Else
                t2String = Right(celString, 1)
            End If
            tot = tot + t2String
        End If
        Debug.Print tot
    Next
    GetTotal = tot
End Function

您必须提供range作为输入。

见下图:

enter image description here