您的位置：程序门 -> vb -> vba

能否让我的自定义函数只计算一次？

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

能否让我的自定义函数只计算一次？[已结贴,结贴人:cooler]

发表于：2007-03-02 02:43:53 楼主

能否让我的自定义函数只计算一次？
我在excel中定义了一个自定义的函数。类似如下：

function myttt（a, b) as double

'类似哈，但是执行比较慢，要10多秒
myttt = a * b
end function

由于这个文件定义成了自动计算，结果每次打开的时候，excel都会重新调用这个函数，结果造成excel文件打开很慢（要十多分钟）。

因为有很多个单元格都调用了这个函数。嘿嘿。

我想，能否有种方法，让这个函数每个单元格只执行一次就ok了。

也就是说，在我这个函数里面自己判断调用他的单元格，

如果不等于0，就执行，否则就停止执行。

结果经过版主的指点，我知道函数是可以自己被哪个单元格调用的，

方法是调用application.caller。

很接近成功了，是不是。可惜，很可惜，问题出现了。

我的代码改成了：

function myttt（a, b) as double

dim t

t= application.caller.value

'类似哈，但是执行比较慢，要10多秒

if t <> 0 then
myttt = a * b

else

myttt=t '原值返回，就不慢了

end if
end function

结果这个函数一执行就报错。excel说发现有一个循环调用的方法。

我调试还发现，application.caller.text不会报错，但是永远＝0。

请问诸位有没有什么好方法哈？或者想法也可以，我来实现。拜求了！！！！

－－－－－－－－－－－－－

我的其他尝试：

1、把这个excel改成手工计算，打开变快了。

但是用户编辑的时候，需要自动计算环境。结果一旦把excel改回成自动计算，

excel默认会自动把所有单元格都算一遍，结果，又是等待10多分钟才改得回来。

2、尝试把excel文件设成保护。结果发现即使excel文件设置成保护，在自动计算模式下，

一打开的时候，excel还是会把每个单元格计算一遍。盖滋果然心理**啊。

－－－－－－－－－－－－－

当然了，我这个问题也很**。希望有高手支招。谢谢！

发表于：2007-03-02 09:41:461楼得分:0

不要用自定义函数
改用事件
假设你的公式是a=b+c
一旦发现b或c有变化则重算并把计算结果写入a

建议使用
private sub worksheet_selectionchange（byval target as range)

end sub

发表于：2007-03-05 01:29:572楼得分:0

谢谢。不过这等于是完全抛弃了ＥＸＥＣl的所长啊。

我还在找一种用户性更号的方法。不过感谢支招

发表于：2007-03-05 08:39:113楼得分:20

用公式就会导致重新计算,看上去没什么好办法

再给你个折中的方案:
在beforesave事件中扫描所有单元格
把公式的值写入单元格
不足之处就是对固化后的数据做修改可能损害数据一致性

再来一个方案:
采用辅助列做标识位
在最后一列可视数据之后增加一列并设为隐藏

发表于：2007-03-07 00:48:174楼得分:0

搞定了。
方法比较简单。

把计算结果放到excel中，重新计算的时候，判断有没有这个结果的变量，存在就取值，否则就重新计算。呵呵。

excel中存变量的方法：
'设定excel文档参数值
' msopropertytypenumber = 1,
' msopropertytypeboolean = 2,
' msopropertytypedate = 3,
' msopropertytypestring = 4,
' msopropertytypefloat = 5
private sub setp（name as string, value, optional valuetype as integer = 4)
on error resume next
if name = " " or name = null then
exit sub
end if

'msgbox name & " ¦ " & value

dim p
set p = excelworkbook.customdocumentproperties（name)
if p is nothing then
set p = excelworkbook.customdocumentproperties.add（name:=name, linktocontent:=false, _
type:=valuetype, value:=value)
p.value = value
else
p.value = value
end if
set p = nothing
end sub
'获得excel文档参数值
private function getp（name as string)
on error resume next
dim p
set p = excelworkbook.customdocumentproperties（name)
if p is nothing then
getp = " "
else
getp = p.value
end if
set p = nothing
end function

其他资讯