行が挿入されたときにUDFが更新されない

Question

私は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 

Answer 1

についてheadrng最初のアドレス記念として空セルはheadrng以上です。あなたはheadrng行と1つ上の間に1つ以上の行を挿入する場合は、あなたがそれを使用して数式をコピーしなければならないので、それは1000倍、それがなければなりませんをループ程度と異なる振る舞い

を持っているなるようにExcelは、あなたのデータの例から一列のみ

さらに変更している場合でも、それらのすべてを計算するように、1000行に私が

しかし、まだフォームを被る可能性があり

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 

を次のようにコードを変更すべきだと思います記念品問題

ので、私はまた、あなたがメッセージボックスをしたくない場合は、Ifステートメントを取り除くことができます

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