防止私人子项调用函数-Excel VBA

时间:2018-11-12 08:13:05

标签: excel vba excel-vba loops volatile

我现在已经理解,因为我的UDF具有Application.Volatile = True,所以我的Private子程序称为UDF。因此,可以通过将其设置为Application.Volatile = False来防止它发生。

问题

在我的函数中,如果未将Volatile设置为True,它将不会更新,这是我的工作表中的关键。而且如前所述,我希望我的私有子对象停止调用我的函数,因为这几乎阻止了我的循环的发生。

目标

因此,我想知道,是否有可能阻止我的Private子程序调用我的函数,因为它位于非常不同的区域。

我的私人子代在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 :(得分:0)

后来知道了一个更好的解决方案,而没有使用UDF ... 我删除了函数,因为它们只会在我的工作表中出现问题。

然后我通过名称管理器创建了一个命名范围,将其命名为“工作表列表”
之后,我将此公式分配给它所指的内容:=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
到概述表,已经完成了自我更新的技巧:)