FOR цикл внутри UDF в Excel не работает - PullRequest
0 голосов
/ 28 декабря 2018

В настоящее время я программирую функцию 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 программа прерывается.

У кого-нибудь была такая же проблема?Может ли кто-нибудь помочь мне с этим?

Ответы [ 3 ]

0 голосов
/ 28 декабря 2018

Массивы быстрее

Окончательная версия (надеюсь)

Эта версия дополнительно имеет аргумент NumberOfLastValues ( Обязательно ), поэтому вы можете выбрать, сколько значений будетсуммируется и сокращается с помощью оператора 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.

Параметр arguments Row_0_Column_1 по умолчанию равен 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
0 голосов
/ 05 января 2019

после пары трудных дней на работе у меня наконец-то появилось время для улучшения своей функции с учетом ваших советов.

Я внес некоторые изменения, чтобы позволить функции справляться с 1-Ряды или ряды с 1 колонкой.Также была добавлена ​​базовая обработка ошибок и функция discripton (под кнопкой 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
'

Рафа

0 голосов
/ 28 декабря 2018

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...