1

我目前正在编写一个 Excel 函数，它应该返回数组最后 5 个非空位置的平均值。为此，我想在函数内部遍历数组，如下所示：

Function AVERAGE_LAST_5(rng As Range) As Long
    Dim x As Integer, i As Integer, j As Integer, sum As Integer
    Dim myArr() As Variant

    myArr() = Application.Transpose(Application.Transpose(rng))
    x = rng.Count
    i = 0:: j = 0:: sum = 0

    For i = x To 1 Step -1

        If myArr(x).Value <> 0 Then
            sum = sum + myArr(x)
            j = j + 1
        Else
        End If

        If j = 5 Then Stop
        x = x - 1

    Next

    AVERAGE_LAST_5 = sum / 5

End Function

问题：for循环不起作用，当到达第一个程序时if，程序中止。

有没有人遇到过同样的问题？有人可以帮我吗？

4

3 回答 3

0

数组更快

最终版本（希望）

此版本还具有NumberOfLastValues参数 ( Required )，因此您可以选择汇总多少个值并使用GoSub...Return语句缩短它，因为If语句对于按行和按列是相同的。
有关其他详细信息，请参阅下面的第一个版本。

用法

在 VBA 中：

Sub LastAverage()
  Debug.Print AvgLast(Range("B4:G14"), 5)
End Sub

在 Excel 中：

=AvgLast(B4:G14,5)

Function AvgLast(SearchRange As Range, ByVal NumberOfLastValues As Long, _
    Optional ByVal Row_0_Column_1 As Integer = 0) As Double

  Dim vntRange As Variant   ' Range Array

  Dim i As Long             ' Range Array Rows Counter
  Dim j As Integer          ' Range Array Columns Counter
  Dim k As Long             ' Values Counter
  Dim dblSum As Double      ' Values Accumulator

  If SearchRange Is Nothing Then Exit Function

  vntRange = SearchRange.Value

  If Row_0_Column_1 = 0 Then
    ' By Row
    For i = UBound(vntRange) To 1 Step -1
      For j = UBound(vntRange, 2) To 1 Step -1
        GoSub Calc
      Next
    Next
   Else
    ' By Column
    For j = UBound(vntRange, 2) To 1 Step -1
      For i = UBound(vntRange) To 1 Step -1
        GoSub Calc
      Next
    Next
  End If

TiDa:
  If k > 0 Then
    AvgLast = dblSum / k
  End If
Exit Function

Calc:
  If vntRange(i, j) <> "" And IsNumeric(vntRange(i, j)) Then
    k = k + 1
    dblSum = dblSum + vntRange(i, j)
    If k = NumberOfLastValues Then GoTo TiDa
  End If
Return

End Function

第一个版本

如果至少有 1 个值且最多 5 个值，它将返回平均值，否则将返回 0。

Row_0_Column_1 arguments 参数默认为 0，表示搜索按行（第一个循环）完成。如果为 1，则按列进行搜索（第二个循环）。

基本原理是将范围粘贴（depsited）到一个数组中，然后在数组中搜索现有的“数字”值，而不是求和的“”值，当达到第五个值时，它“跳”出循环并将总和除以 5。

Function AvgLast5(SearchRange As Range, Optional Row_0_Column_1 As Integer = 0) _
    As Double

  Dim vntRange As Variant   ' Range Array

  Dim i As Long             ' Range Array Rows Counter
  Dim j As Integer          ' Range Array Columns Counter
  Dim k As Long             ' Values Counter
  Dim dblSum As Double      ' Values Accumulator

  If SearchRange Is Nothing Then Exit Function

  vntRange = SearchRange.Value

  If Row_0_Column_1 = 0 Then
    ' By Row
      For i = UBound(vntRange) To 1 Step -1
        For j = UBound(vntRange, 2) To 1 Step -1
          If vntRange(i, j) <> "" And IsNumeric(vntRange(i, j)) Then
            k = k + 1
            dblSum = dblSum + vntRange(i, j)
            If k = 5 Then GoTo TiDa
          End If
        Next
      Next
    Else
    ' By Column
      For j = UBound(vntRange, 2) To 1 Step -1
        For i = UBound(vntRange) To 1 Step -1
          If vntRange(i, j) <> "" And IsNumeric(vntRange(i, j)) Then
            k = k + 1
            dblSum = dblSum + vntRange(i, j)
            If k = 5 Then GoTo TiDa
          End If
        Next
      Next
  End If

TiDa:

  If k > 0 Then
    AvgLast5 = dblSum / k
  End If

End Function
于 2018-12-28T01:03:55.950 回答
0

经过几天艰苦的工作后，我终于有了一些时间来改善我的功能，并听取您的建议。

我进行了一些更改以使该函数能够处理 1 行或 1 列范围。还添加了基本错误处理，并且还提供了功能描述（在 FX Excel 按钮下）。

随意评论和/或使用代码。结果如下：

Function AVERAGE_LAST_N(rng As Range, N As Integer)

Dim NrN As Integer, NrR As Integer, NrC As Integer
Dim i As Integer, j As Integer
Dim sum As Double
Dim myArr As Variant

    NrN = rng.Count           'Number of array positions
    NrR = rng.Rows.Count      'Number of Rows in the array
    NrC = rng.Columns.Count   'Number of Rows in the array
    i = 0:: j = 0:: sum = 0   'Counters

    '####################################################'
    '## Transpose Range into array if row or if column ##'
    '####################################################'

          If rng.Rows.Count > 1 And rng.Columns.Count = 1 Then             'Transpose a Column Range into an Array
               myArr = Application.Transpose(rng)

          ElseIf rng.Rows.Count = 1 And rng.Columns.Count > 1 Then         'Transpose a Row Range into an Array
              myArr = Application.Transpose(Application.Transpose(rng))

          ElseIf rng.Rows.Count > 1 And rng.Columns.Count > 1 Then         'Retunrs an Error if Range is a Matrix *ERR_002*
              AVERAGE_LAST_N = "ERR_002"
              Exit Function

          End If

    '####################################################'
    '## Transpose Range into array if row or if column ##'
    '####################################################'


    '################'
    '## Start Main ##'
    '################'

          For i = NrN To 1 Step -1
               If IsNumeric(myArr(NrN)) Then
                    sum = sum + myArr(NrN)
                    j = j + 1

               End If

               If j = N Then Exit For

               NrN = NrN - 1

          Next

          AVERAGE_LAST_N = sum / N

    '##############'
    '## End Main ##'
    '##############'


    '####################'
    '## Error Debuging ##'
    '####################'

          If j < N Then
              AVERAGE_LAST_N = "ERR_001"
              Exit Function
          End If

    '####################'
    '## Error Debuging ##'
    '####################'

End Function

Sub DescribeFunction()

   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1) As String

   FuncName = "AVERAGE_LAST_N"
   FuncDesc = "Returns the average of the last N non-empty values in the selected Range"
   Category = 14 'Text category
   ArgDesc(0) = "Range that contains the values" & Chr(10) & _
               "ERR_001 - There are not enought non-empty or null values in the range" & Chr(10) & _
               "ERR_002 - Selected range is a matrix and not a row or column range"

   ArgDesc(1) = "Dimention of the sample" & Chr(10) & _
               "ERR_001 - There are not enought non-empty or null values in the range" & Chr(10) & _
               "ERR_002 - Selected range is a matrix and not a row or column range"

   Application.MacroOptions _
       Macro:=FuncName, _
       Description:=FuncDesc, _
       Category:=Category, _
       ArgumentDescriptions:=ArgDesc

End Sub


'#######################################################################################

'                   ###############################################
'                   #############      Error DB      ##############
'                   ###############################################
'
'
'    ERR_001 - There are not enought non-empty values in the range
'    ERR_002 - Selected range is a matrix and not a row or column range
'

拉法

于 2019-01-05T12:56:06.957 回答
0

myarr 将是一个二维数组，而不是一个范围。您需要提供两个维度：

If isarray(myarr) then
for i = ubound(myarr,1) to lbound(myarr,1) step -1
    for j = ubound(myarr,2) to lbound (myarr,2) step -1
       if myarr(i,j) <> 0 then
           K=k+1
           Mysum = mysum + myarr(I,j)
        Endif
    Next j
Next i
Else ‘ single value
    mysum =myarr(I,j)
Endif
于 2018-12-27T23:33:50.280 回答