根据用户定义的函数创buildVBA函数

感谢所有在我的问题上帮助过我的朋友， 如何在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))

提前致谢

Answer 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作为input。

看到下面的图片：

Answer 2

我认为这个函数实现了这个公式。 在单元格中没有原始数据的情况下进行testing是非常困难的。 注意这个函数是从下面的Foo子例程调用的，所以你可以传入一个variables范围到函数。 希望有所帮助。

 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