插入行时 UDF 不更新

Question

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

另外。我的函数似乎循环了很多次。在我的代码中，您会看到一个消息框出现在 1000 行之后。所以我知道它至少循环了 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

Answer 1

关于 headrng 第一个地址 remembrance 这一定是你如何检查 subranges 的问题，依赖于headrng 本身存在某些非空白单元格。因此，如果您在 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

然而，这仍然会受到纪念问题

的影响

所以我也会投入不同的 "subranges" 检查如下

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

插入行时 UDF 不更新

UDF not updating when rows inserted

excel

vba

user-defined-functions

udf