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