在VBA中查找数组中的最小正值(大于0)

时间:2012-11-14 16:42:23

标签: excel function vba excel-vba

我有一个数组(AlphaVector),其中包含以下值:

-0.2
-0.7
0
0.4
0.3
0.1

我想从上面的数组中选择正值并将其放在另一个名为Alpha的数组中,以便我可以从Alpha中选择最小正值。我的目标是从上面的数组中获得值0.1。 这是我到目前为止的代码。当Msgbox指示正确的值时,Alpha会被填充,但我得到的返回值是0而不是0.1。

Function FindMin(AlphaVector)
Dim iCount As Long
Dim N As Integer, i As Integer
N = AlphaVector.Cells.Count
Dim Alpha() As Double
ReDim Alpha(N) As Double
For i = 1 To N
    If AlphaVector(i) > 0 Then
        Alpha(i) = AlphaVector(i)
    Else
        Alpha(i) = 100000000000#
    End If
    MsgBox ("Alpha(i)= " & Alpha(i))
    MsgBox ("AlphaVector(i)= " & AlphaVector(i))
Next i
FindMin = WorksheetFunction.Min(Alpha)
End Function

你能告诉我如何解决它吗?此外,如果有更有效的方式来编写它,也许没有引入Alpha,请告诉我。感谢。

4 个答案:

答案 0 :(得分:3)

您对数组Alpha使用了错误的索引。它从零开始,并且由于您使用i填充它,从1开始,您将Alpha(0)保留为默认值,即0。

WorksheetFunction.Min(Alpha)返回最小值,您现在知道它总是为0.: - )

你需要重新设计你的功能来处理这个问题。示例将在稍后进行。

编辑 - 代码示例 - 已更新为UDF

我在看到你的评论之前完成了这个示例,因此在我的代码中AlphaVector是一个数组。无论如何,最好明确声明任何变量并尽可能避免使用Variant类型,如果不声明变量则使用它。这就是我使用Option Explicit的原因。你也应该。 : - )

可能有很多方法可以做你想要的,但这是一个:

Option Explicit

Function FindMin(AlphaVector)
    Dim iNew As Integer, i As Integer
    Dim iCount As Integer
    Dim Alpha() As Variant

    iCount = AlphaVector.Cells.Count

    '***** Use size of AlphaVector
    ReDim Alpha(0 To iCount - 1)
    iNew = 0

    For i = 1 To iCount
        '***** Only save values greater than 0
        If AlphaVector(i) > 0 Then
            Alpha(iNew) = AlphaVector(i)
            '***** Keep track of how many values you save
            iNew = iNew + 1
        End If
    Next i

    '***** Remove any empty items in the Alpha array
    ReDim Preserve Alpha(0 To iNew - 1)

    '***** Reture result of the Min function
    FindMin = WorksheetFunction.Min(Alpha)
End Function

答案 1 :(得分:2)

只是一个FYI,您可以在具有数组功能的Excel中的单个单元格中执行此操作。如果您的示例号码在A1:A6中使用

 =MIN(IF(A1:A6<=0,"",A1:A6))

但请确保使用Ctrl-Shift-Enter输入它以使其成为数组公式。 VBA不是必需的。

答案 2 :(得分:1)

这里的问题是如何设置Alpha变量数组的维度。在您的代码中,我假设您的模块没有声明Option Base 1。因此,Alpha的维度为Alpha(0 to 6),而且它是Double数组,第一个零元素默认为0.简单的更改是将代码更改为:

ReDim Alpha(1 to N) As Double

答案 3 :(得分:0)

你可以改到下面,更清洁一点:


Function FindMinUpdated(AlphaVector As Range)

Dim cell As Range Dim lowValCell As Double

lowValCell = Abs(AlphaVector(1))

For Each cell In AlphaVector

    lowValCell = IIf(cell < lowValCell And cell > 0, cell, lowValCell)

Next cell

FindMinUpdated = lowValCell

End Function