Предотвратить частную подпрограмму от вызова функции - Excel VBA - PullRequest
0 голосов
/ 12 ноября 2018

Теперь я понял, что мой частный саб вызывает мой UDF, потому что мой UDF имеет Application.Volatile = True.Поэтому я могу предотвратить это, установив вместо этого Application.Volatile = False.

Проблема

Без установки Volatile на True в моей функции, он выигралне обновить, который является ключевым в моем листе.И, как упоминалось ранее, я хотел бы, чтобы моя частная сабвуфер перестала вызывать мою функцию, так как она в значительной степени останавливает мой цикл.

Цель

Поэтому я бы хотелчтобы узнать, возможно ли запретить моей частной подпрограмме вызывать мою функцию, поскольку она расположена в очень разных областях.

Моя частная подпрограмма вставляет новое значение в B19, тогда как моя функция помещается в A2.

Заранее спасибо

По запросу вот код:

Sub UpdateSheets()
Dim WS_count As Integer
Dim I As Integer
Dim sht As Worksheet

Today = Date

WS_count = ActiveWorkbook.Worksheets.Count

For I = 1 To WS_count
    If I = 1 Then
        Else
        Set sht = Sheets(I)
            LnLAddress = sht.Range("A:A").Find("Lease end lessee:", , LookIn:=xlValues).Address(False, False, xlA1)
            LnLOff = sht.Range(LnLAddress).Offset(0, 1).Address(False, False, xlA1)
            LnLVal = sht.Range(LnLOff).Value
            NtceAddress = sht.Range("A:A").Find("Notice:", , LookIn:=xlValues).Address(False, False, xlA1)
            NtceOff = sht.Range(NtceAddress).Offset(0, 1).Address(False, False, xlA1)
            NtceVal = sht.Range(NtceOff).Value
            On Error GoTo Ending:
            NtceVal = Left(NtceVal, Application.WorksheetFunction.Find(" ", NtceVal) - 1)
            LnLVal = DateSerial(Year(LnLVal), Month(LnLVal) - NtceVal, Day(LnLVal))
            LnLYear = Year(LnLVal)
            On Error GoTo 0
                If LnLVal <= Today Then
                    AutoExtAddress = sht.Range("A:A").Find("Automatical extension of contract", , LookIn:=xlValues).Address(False, False, xlA1)
                    AutoExtOff = sht.Range(AutoExtAddress).Offset(0, 1).Address(False, False, xlA1)
                    AutoExtVal = sht.Range(AutoExtOff).Value
                    AutoExt = Left(AutoExtVal, Application.WorksheetFunction.Find(" ", AutoExtVal) - 1)
                    LnLNewVal = DateSerial(Year(LnLVal) + AutoExt, Month(LnLVal) + NtceVal, Day(LnLVal))
                    Application.Calculation = xlCalculationManual
                    sht.Range(LnLOff).Value = LnLNewVal
                    Application.Calculation = xlCalculationAutomatic 'loop through functions starts here...
                End If
    End If
Ending:
On Error GoTo 0
Next I

End Sub

А вот функции:

Function SHEETNAME(number As Long) As String
Application.Volatile True
    SHEETNAME = Sheets(number).Name
End Function

Function NxtShtNm(number As Long) As String
Application.Volatile True
    NxtShtNm = ActiveWorkbook.Sheets(ActiveSheet.Index + number - 1).Name
End Function

1 Ответ

0 голосов
/ 13 ноября 2018

позже стало известно лучшее решение без создания UDF ... Я удалил свои функции, поскольку они создавали проблемы только на моем листе.

Затем я сделал именованный диапазон из диспетчера имен, назвав его «listlist»
После этого я присвоил эту формулу тому, к чему она относится: =REPLACE(GET.WORKBOOK(1);1;FIND("]";GET.WORKBOOK(1));"")&T(NOW())

Составление формулы в ячейках, где мне нужно ссылаться на рабочие тетради: =IFERROR(HYPERLINK("#'" & INDEX(sheetlist;ROW()) & "'!A1";INDEX(sheetlist;ROW()));"")

Теперь он ссылается на листы по порядку и присваивает:
Private Sub WorkSheet_Activate() ActiveWorksheet.Calculate End sub
на обзорном листе, сделал трюк с обновлением себя:)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...