插入行时UDF不更新

时间:2016-05-12 14:19:18

标签: excel vba user-defined-functions udf

我对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

1 个答案:

答案 0 :(得分:1)

关于headrng第一个地址记忆,必须考虑如何检查子范围,依赖于某些非空白的存在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
然而,

仍然会受到记忆问题

的影响

所以我也会投入不同的&#34;子范围&#34;检查如下

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