Excel VBA编辑器中的UDF仅在需要Double时才会返回零

此function用于计算闭合导线的面积。 当作为一个子书写并分配给一个特定的单元格时,该子作品完美。 但是,当作为函数使用时(如下所示),它只返回零。 为什么? “function旨在适应任何数量的横向边

Public Function TraverseArea() As Double Dim Area As Double Area = 0 Range("N2").Select Area = (ActiveCell.Value * (Range("M2").End(xlDown).Offset(-1, 0).Value - ActiveCell.Offset(1, -1).Value)) ActiveCell.Offset(1, 0).Select While ActiveCell.Offset(1, -1) <> "" Area = Area + (ActiveCell.Value * (ActiveCell.Offset(-1, -1).Value - ActiveCell.Offset(1, -1).Value)) ActiveCell.Offset(1, 0).Select Wend If Area < 0 Then Area = Area * -1 End If Area = Area / 2 TraverseArea = Area End Function 

我没有你的数据或表单结构,所以这一切都是我的头脑,但这应该给你一个想法,你如何能没有专门使用硬编码的范围在你的function。

 Sub TestFunction() MsgBox TraverseArea(Range("N2"), Range("M2").End(xlDown).Offset(-1, -1)) End Sub Public Function TraverseArea(MyRange As Range, MySecondRange As Range) As Double Dim Area As Double, lr As Long, X as long lr = Cells(Rows.Count, MyRange.Column).End(xlUp).Row Area = (MyRange.Value * (MySecondRange.Value - MyRange.Offset(1, -1).Value)) For X = MyRange.Row To lr If Cells(X, MyRange.Column - 1) = "" Then Exit For Area = Area + (ActiveCell.Value * (ActiveCell.Offset(-1, -1).Value - ActiveCell.Offset(1, -1).Value)) Next If Area < 0 Then Area = Area * -1 Area = Area / 2 TraverseArea = Area End Function 

这很可能需要一些debugging,但应该足以让你知道我在之前关于使用单元格引用而不select它们的评论中想说的话。

该代码作为一个子程序工作,因为你有正确的工作表,因为ActiveSheet属性和subs允许你使用Range .Select方法和范围.Activate方法¹。 在工作表上使用的函数需要知道它在哪个工作表上,select单元格不是一个被批准的方法。

 Public Function TraverseArea(Optional aRNG As Variant) As Double Dim dAREA As Double, r As Long, rng As Range dAREA = 0 With Application.Caller.Parent If IsMissing(aRNG) Then Set aRNG = .Range("N2") For Each rng In .Range(aRNG, aRNG.End(xlDown)) If IsEmpty(rng) Or Not IsNumeric(rng) Or Not CBool(Len(rng.Offset(1, -1))) Then _ Exit For With rng 'Area = Area + (ActiveCell.Value * (ActiveCell.Offset(-1, -1).Value - ActiveCell.Offset(1, -1).Value)) dAREA = dAREA + .Value2 * (.Offset(0, -1).End(xlDown).Offset(-1, 0).Value2 - .Offset(1, -1).Value2) End With Next rng End With If dAREA < 0 Then dAREA = dAREA * -1 End If dAREA = dAREA / 2 TraverseArea = dAREA End Function 

Application.Caller帮助查找函数所在的父级工作表。 没有select或激活单元格,但是通过提供行号,列号和对Range.Offset属性的某些操作,通过使用直接寻址来循环。


¹ 请参阅如何避免使用在Excel VBAmacros中select更多的方法来摆脱依靠select和激活来实现您的目标。