UDF nicht aktualisiert, wenn Zeilen eingefügt

Question

Ich bin ziemlich neu zu UDFs und ich bin mir nicht sicher, ganz wie sie funktionieren. Meine Funktion gibt korrekte Informationen zurück, solange keine neuen Zeilen eingefügt werden. Es ist, als ob headRng bei der ersten Verwendung gespeichert wird und nicht aktualisiert wird, selbst wenn eine neue Zeile eingefügt wird. Wie kann ich das beheben?

Zusätzlich. Meine Funktion scheint eine Menge von Schleifen zu sein. In meinem Code wird eine Nachrichtenbox angezeigt, die nach 1000 Zeilen angezeigt wird. Ich weiß also, dass es mindestens 1000 Mal wiederholt wird. Keine Ahnung, warum es schleift. Ich habe vergessen, dass eine andere Arbeitsmappe mit derselben Funktion geöffnet wurde, die die Schleife über 1000 verursachte.

Beispiel dafür, wie es verwendet werden könnte: 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

wie etwa headrng erste Adresse Erinnerung es eine Frage, wie man Teilbereiche, die sich auf das Vorhandensein bestimmter nicht sind prüft werden müssen leere Zellen über headrng selbst. so dass, wenn Sie eine oder mehr Zeilen zwischen headrng Reihe und den darüber einfügen, wäre es ein anderes Verhalten

wie etwa die Looping 1000 mal hat es sein muss, weil Sie eine Formel kopiert haben muss, dass es nach unten verwendet rudern 1000, so dass Excel auch alle von ihnen berechnet, wenn Sie nur eine Zeile

außerdem aus Ihren Daten Beispiel zu ändern denke ich, sollten Sie Code ändern, wie

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 

folgt, die aber noch Form leiden könnte die Erinnerung Ausgabe

so würde ich auch in einer anderen „Unterbereiche“ werfen Überprüfung wie folgt

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