插入行时 UDF 不更新

Posted 2023-04-14

【中文标题】插入行时 UDF 不更新

【英文标题】：UDF not updating when rows inserted

【发布时间】：2016-05-12 14:19:18

【问题描述】：

我对 UDF 还很陌生，我不确定它们是如何运作的。只要没有插入新行，我的函数就会返回正确的信息。就好像headRng 在第一次使用时被保存到内存中，即使插入新行也不会更新。我该如何解决这个问题？

另外。我的函数似乎循环了很多次。在我的代码中，您会看到在 1000 行之后出现的 msgbox。所以我知道它至少循环了 1000 次。不知道为什么它会循环。忘记了我打开了另一个工作簿，它具有相同的功能，导致 1000+ 循环。

如何使用它的示例：https://i.imgur.com/zRQo0SH.png

Function StraightLineFunc(headRng As Range, dataRng As Range) As Double
    Application.Volatile True
    Dim arrCntr As Integer
    Dim arr() As Variant
    Dim rowOffset As Integer
    Dim cntr As Integer
    Dim stdvTotal As Double

    stdvTotal = 0
    cntr = 0
    arrCntr = 1

    For Each cell In headRng
        If cell <> "Response" And cell <> "Open-Ended Response" And cell <> "" Then
            If cell.Offset(-1, 0) <> "" And cntr > 0 Then
                stdvTotal = stdvTotal + StdDev(arr)
            End If
            If cell.Offset(-1, 0) <> "" Then
                cntr = cntr + 1
                'new grouping heading
                Erase arr
                ReDim arr(headRng.Columns.Count)
                arrCntr = 1
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
                arrCntr = arrCntr + 1
            Else
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
                arrCntr = arrCntr + 1
            End If
        End If
    Next cell
    stdvTotal = stdvTotal + StdDev(arr)
    StraightLineFunc = stdvTotal
End Function

Function StdDev(arr)
     Dim i As Integer
     Dim avg As Single, SumSq As Single
     Dim k1 As Long, k2 As Long

     Dim n As Long
     k1 = LBound(arr)
     k2 = UBound(arr)
     n = 0
     avg = Mean(arr)
     For i = k1 To k2
        If arr(i) = 0 Or arr(i) = "" Then
        'do nothing
        Else
           n = n + 1
             SumSq = SumSq + (arr(i) - avg) ^ 2
        End If
     Next i
     StdDev = Sqr(SumSq / (n - 1))
End Function

Function Mean(arr)
     Dim Sum As Single
     Dim i As Integer
     Dim k1 As Long, k2 As Long
     Dim n As Long
     k1 = LBound(arr)
     k2 = UBound(arr)
     Sum = 0
     n = 0
     For i = k1 To k2
        If arr(i) = 0 Or arr(i) = "" Then
        'do nothing
        Else
            n = n + 1
            Sum = Sum + arr(i)
        End If
     Next i
     Mean = Sum / n
End Function

【问题讨论】：

如果你不想要 msgbox，你可以去掉 If 语句。另外，您是从代码中的其他位置调用函数还是将其用作公式？

您需要将传入的内容显示为 headRng 和 dataRng，以便有足够的上下文。代码围绕 headRng 循环，因此该范围的定义可能是您的问题的原因？

@Dave，刚刚添加了一张使用效果的图片。

@Brian，我更新了我的帖子以使其更加清晰

@Ralph，如您在上面看到的，我已经将它包含在我的代码中。它似乎没有正确解决这个问题。

【参考方案1】：

关于headrng 第一个地址remembrance 这一定是您如何检查子范围 的问题，这取决于@987654322 上是否存在某些非空白单元格@ 本身。因此，如果您在 headrng 行与其上方的行之间插入一行或多行，它将具有不同的行为

关于 循环 1000 次，这一定是因为您必须将使用它的公式复制到第 1000 行，这样即使您只更改一行，excel 也会计算所有这些

此外，从您的数据示例中，我认为您应该按如下方式更改代码

Option Explicit

Function StraightLineFunc1(headRng As Range, dataRng As Range) As Double
    Application.Volatile True
    Dim arrCntr As Integer
    Dim arr() As Variant
    Dim rowOffset As Integer
    Dim cntr As Integer
    Dim stdvTotal As Double
    Dim cell As Range

    stdvTotal = 0
    cntr = 0
    arrCntr = 1

    For Each cell In headRng
        If cell <> "Response" And cell <> "Open-Ended Response" And cell <> "" Then
            If cell.Offset(-1, 0) <> "" And cntr > 0 Then
                stdvTotal = stdvTotal + WorksheetFunction.StDev(arr)
            End If
            If cell.Offset(-1, 0) <> "" Then
                cntr = cntr + 1
                'new grouping heading
                Erase arr
                arrCntr = 1
                ReDim Preserve arr(1 To arrCntr)
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
            Else
                arrCntr = arrCntr + 1
                ReDim Preserve arr(1 To arrCntr)
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
            End If
        End If
    Next cell
    stdvTotal = stdvTotal + WorksheetFunction.StDev(arr)
    StraightLineFunc1 = stdvTotal
End Function

然而，它仍然可能受到纪念问题的影响

所以我也会加入不同的“子范围”检查，如下所示

Function StraightLineFunc2(headRng As Range, dataRng As Range) As Double
    'Application.Volatile True
    Dim stdvTotal As Double
    Dim j1 As Long, j2 As Long

    j1 = 1
    Do Until InStr("Open-Ended Response", headRng(1, j1)) = 0 And headRng(1, j1) <> ""
        j1 = j1 + 1
    Loop
    Set headRng = headRng.Offset(, j1 - 1).Resize(, headRng.Columns.Count - j1 + 1)

    j1 = 1
    Do While j1 < headRng.Columns.Count
        j2 = j1
        Do While headRng(1, j2) <> "Response" And j2 <= headRng.Columns.Count
            j2 = j2 + 1
        Loop
        stdvTotal = stdvTotal + WorksheetFunction.StDev(Range(headRng(1, j1), headRng(1, j2 - 1)).Offset(dataRng.Row - headRng.Row))
        j1 = j2 + 1
    Loop

    StraightLineFunc2 = stdvTotal
End Function