Страницы: 1
RSS
UDF в умных таблицах не пересчитываются автоматически, cо строкой Application.Volatile в коде пользовательской функции возникают ошибки
 
Добрый день!

Краткое описание проблемы: Наткнулся на проблему, есть книга Execel с набором макросов и пользовательских функций, функции сложные и используют дополнительные функции. Проблема состояла в том, что пользовательские функции, вбитые в "умную таблицу" "отказывались" пересчитываться автоматически, пересчитывались только через двойной клик и Enter.  Частично проблему решила строка Application.Volatile, однако при открытии новой книги Excel или же копировании и вставке все пользовательские функции сваливаются в ошибку, а при копировании и вставке только значений, вставляется текст ошибки

Вопрос: можно ли обойтись без Application.Volatile? Если у кого-то была подобная проблема, как вы с ней боролись?)
 
Лень - двигатель прогресса, а энтузиазм его топливо
 
Цитата
lodman_geo написал:
можно ли обойтись без Application.Volatile
если хотите, чтобы функции пересчитывались - нет. Хотя нет, можно. Использовать доп.параметр.  Здесь приводил подробный пример: Что такое функция пользователя(UDF)? Ищите в заголовке Обновление расчетов функции пользователя UDF(автопересчет)
Но ошибка явно не в этой строке, а в самих функциях. Вероятно, они просто не учитывают использование их в умной таблице или по некоему другому сценарию.  
Изменено: Дмитрий(The_Prist) Щербаков - 09.12.2019 11:50:54
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Вероятно, они просто не учитывают использование их в умной таблиц
А как это можно учесть, можно пример, пожалуйста?  
Лень - двигатель прогресса, а энтузиазм его топливо
 
Цитата
lodman_geo написал:
можно пример
нет. Пример от Вас как раз нужен. Потому что это учитывается логикой самой функции. Мы же её не видим, следовательно и посоветовать можем только что-то обобщенное.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, Вам сбросить файл, или же пример кода? Просто в файле у меня куча модулей, сложно будет разобраться
Изменено: lodman_geo - 09.12.2019 12:28:16 (опечатка)
Лень - двигатель прогресса, а энтузиазм его топливо
 
Например:
Код
Option Explicit
Dim tabSTATE As Range
Dim esl_loess As Range
Dim psl_loess As Range

Function ПРОСАД(nEGE As String, opTYPE%, Optional MODE$ = "VOID", Optional sSetE$ = "VOID", Optional sSetSr$ = "VOID")
' (opTYPE: 0 - оба показателя; 1 - относительная просадочность; 2 - начальное просадочное давление)
  
  Dim dAvrE As Double, dAvrSr As Double 
  Dim soilINDEX As Integer

  Set tabSTATE = Worksheets("Відомість").Range("tb_State")
  Set esl_loess = Range("esl_loess")
  Set psl_loess = Range("psl_loess")

    With tabSTATE
      If sSetE = "VOID" Then dAvrE = AvrIF(.Columns(27), .Columns(1), nEGE, 0) Else dAvrE = CDbl(sSetE)
      If sSetSr = "VOID" Then dAvrSr = AvrIF(.Columns(28), .Columns(1), nEGE, 0) Else dAvrSr = CDbl(sSetSr)
      If MODE = "VOID" Then soilINDEX = AvrIF(.Columns(36), .Columns(1), nEGE, 0) Else soilINDEX = CInt(MODE)
      If dAvrE = 0 And dAvrSr = 0 Then ПРОСАД = "-": Exit Function
    End With

    If soilINDEX = 1 Then

      If opTYPE = 0 Then

        If Fxy(esl_loess, dAvrSr, dAvrE) >= 0.01 Then
          ПРОСАД = Round(Fxy(esl_loess, dAvrSr, dAvrE), 3) & " | " & Round(Fxy(psl_loess, dAvrSr, dAvrE), 2)
        Else
         ПРОСАД = "Н/П"
        End If

      ElseIf opTYPE = 1 Then

        If Fxy(esl_loess, dAvrSr, dAvrE) >= 0# Then
          ПРОСАД = Round(Fxy(esl_loess, dAvrSr, dAvrE), 3)
        Else
          ПРОСАД = "-"
        End If

      ElseIf opTYPE = 2 Then

        If Fxy(esl_loess, dAvrSr, dAvrE) >= 0.01 Then
          ПРОСАД = Round(Fxy(psl_loess, dAvrSr, dAvrE), 3)
        Else
          ПРОСАД = "-"
        End If

      End If

    ElseIf soilINDEX = 0 Then

      ПРОСАД = "-"

    End If

  'ПРОСАД = dAvrE & " | " & dAvrSr & " | " & soilINDEX
End Function
Вспомогательные функции для выше проведенной (находятся в отдельном модуле)
Код
Function Fxy#(Tablo As Range, r#, c#)

  Dim oneROW As Boolean, oneCOL As Boolean
  Dim xVAL#
  Dim ri&, ci&
  Dim x1#, x2#, y1#, y2#
  Dim a10#, a20#, a01#, a02#
  Dim a11#, a12#, a21#, a22#
    
  On Error Resume Next
    
    If Tablo.Rows.Count = 2 Then oneROW = True Else oneROW = False
    If Tablo.Columns.Count = 2 Then oneCOL = True Else oneCOL = False
    
    If oneROW = True And oneCOL = False Then
      ri = 2
      ci = 1 + FindIndex(Range(Tablo.Cells(1, 2), Tablo.Cells(1, Tablo.Columns.Count)), c)
        a01 = Tablo.Cells(1, ci):      a02 = Tablo.Cells(1, ci + 1)
        a11 = Tablo.Cells(ri, ci):     a12 = Tablo.Cells(ri, ci + 1)
          x1 = a01:       x2 = a02
          y1 = a11:       y2 = a12
          xVAL = c
    ElseIf oneROW = False And oneCOL = True Then
      ri = 1 + FindIndex(Range(Tablo.Cells(2, 1), Tablo.Cells(Tablo.Rows.Count, 1)), r)
      ci = 2
        a10 = Tablo.Cells(ri, 1):      a20 = Tablo.Cells(ri + 1, 1)
        a11 = Tablo.Cells(ri, ci)
        a21 = Tablo.Cells(ri + 1, ci)
          x1 = a10:       x2 = a20
          y1 = a11:       y2 = a21
          xVAL = r
    ElseIf oneROW = False And oneCOL = False Then
      ri = 1 + FindIndex(Range(Tablo.Cells(2, 1), Tablo.Cells(Tablo.Rows.Count, 1)), r)
      ci = 1 + FindIndex(Range(Tablo.Cells(1, 2), Tablo.Cells(1, Tablo.Columns.Count)), c)
        a01 = Tablo.Cells(1, ci):      a02 = Tablo.Cells(1, ci + 1)
        a10 = Tablo.Cells(ri, 1):      a20 = Tablo.Cells(ri + 1, 1)
        a11 = Tablo.Cells(ri, ci):     a12 = Tablo.Cells(ri, ci + 1)
        a21 = Tablo.Cells(ri + 1, ci): a22 = Tablo.Cells(ri + 1, ci + 1)
          x1 = a01:       x2 = a02
          y1 = Fx(r, a10, a20, a11, a21)
          y2 = Fx(r, a10, a20, a12, a22)
          xVAL = c
    ElseIf oneROW = True And oneCOL = True Then
      Fxy = 0: Exit Function
    End If
    
    Fxy = Fx(xVAL, x1, x2, y1, y2)
    
End Function

Function Fx(x#, x1#, x2#, y1#, y2#)
    Fx = y1 + (x - x1) * (y2 - y1) / (x2 - x1)
End Function

Function FindIndex&(rg As Range, V)
  Dim IncRg As Boolean, i&
  If rg.Cells(1) < rg.Cells(rg.Cells.Count) Then
    If V < rg.Cells(1) Then FindIndex = 1: Exit Function
    If V > rg.Cells(rg.Cells.Count) Then FindIndex = rg.Cells.Count - 1: Exit Function
    FindIndex = WorksheetFunction.Match(V, rg)
  Else
    If V > rg.Cells(1) Then FindIndex = 1: Exit Function
    If V < rg.Cells(rg.Cells.Count) Then FindIndex = rg.Cells.Count - 1: Exit Function
    FindIndex = WorksheetFunction.Match(V, rg, -1)
  End If
End Function

Function AvrIF(TargetRNG As Range, ConditionRNG As Range, Condition As String, Optional altVAL As String)
  On Error GoTo valERR
    AvrIF = Application.WorksheetFunction.AverageIfs(TargetRNG, ConditionRNG, Condition)
Exit Function
valERR: AvrIF = altVAL
End Function
Изменено: lodman_geo - 09.12.2019 12:41:18
Лень - двигатель прогресса, а энтузиазм его топливо
 
Потестирую пока вот такой вариант:
Код
Function ТекущаяДатаВремя(Optional ДиапазонОбновления As Range = Nothing)
    ТекущаяДатаВремя = Now
End Function
Лень - двигатель прогресса, а энтузиазм его топливо
 
Искать ошибку в коде без файла бессмысленно. Надо понимать и видеть где она работает и куда надо скопировать, чтобы перестала работать. Вдруг копируется туда, где просто нет какой-либо таблицы или листа, вот и ошибка?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Наверх