仅在请求时重新计算自定义VBA功能

时间:2013-03-25 03:37:09

标签: excel vba oledb user-defined-functions commandbutton

我的问题是:

我想在电子表格中使用自定义功能区命令按钮甚至是简单的命令按钮来初始化OLEDB数据库连接,并更新/重新计算需要这种连接的所有用户定义的功能,或者我指定的功能。除了单击特定按钮之外,我不希望重新计算任何这些函数。我很难搞清楚如何做到这一点。请提供您的帮助或建议。

请参阅下文,了解我所做的事情:

我目前在访问数据库中存储数据,我在excel中使用vba进行特定查询。我已经通过名称[fnc]在模块下的一组函数中嵌入了每个datarequest例程。然后,我从excel电子表格中将它们作为用户定义的函数进行访问。这里给出一个例子:

 Function ValueV(mm As String, yy As String, qtable As String, qcode As String, compare_period As Integer, average_period As Integer, weight As Boolean) As Variant
 'Month Value Formula for Horizontal Data
 'mm - month value 2-digit
 'yy - year value 4-digit
 'qtable - query table name eg. "cpia"
 'qcode - query code for variable eg. "all0100"
 'avgperiod - lag periods to average in calculation eg. 3-avgperiods for quarterly measure, 1-avgperiod for point measure.
 'weight - boolean (true or false) value for weighting values given reference weight. Currently unsupported. Code should be extended to include this feature. (space holder for now)
  Dim lag_value As Variant
  Dim cur_value As Variant
  lag_value = 0
  cur_value = 0


     'STEP-A: Gets the initial Value average or not.
     '===============================================================
     If compare_period > 0 Then
     'Use this step to pickup initial value when compare_period <> 0 which requires a % change as opposed to a point value.
     'Average_period must be greater than or equal to one (1). One (1) represents the current month which is the same as a point value.
         lmm = fnc.lagdate(mm, yy, compare_period, "mm")                          'lag month (a single month for mValueH)
         lyy = fnc.lagdate(mm, yy, compare_period, "yy")                          'lag year (a single month for mValueH)
         smm = fnc.lagdate(mm, yy, compare_period + average_period - 1, "mm")     'dating backwards to account for average period
         syy = fnc.lagdate(mm, yy, compare_period + average_period - 1, "yy")     'dating backwards to account for average period
         'note, for smm & syy, the average period includes the lmm so we add back one (1)
         'eg. 3-mth average is not 3-lags but current and 2-lags.
         sdate1 = syy & fnc.numtext(smm)
         'start date for query (begining of lag value including average period)

         Set MyRecordset = New ADODB.Recordset
         MySql = sql.sqlVSers(lmm, lyy, qtable, qcode, sdate1)
         'MsgBox (MySql)
         MyRecordset.Open MySql, MyConnect, adOpenStatic, adLockReadOnly

         Do Until MyRecordset.EOF     'Loop to end and enter required values
         lag_value = lag_value + MyRecordset(qcode)
         MyRecordset.MoveNext
         Loop
         'Stop
         lag_value = lag_value / average_period
         MyRecordset.Close
     End If


     'STEP-B: Gets the current Value average or not.
     '===============================================================
         smm = fnc.lagdate(mm, yy, average_period - 1, "mm")           'dating backwards to account for average period
         syy = fnc.lagdate(mm, yy, average_period - 1, "yy")           'dating backwards to account for average period
         sdate1 = syy & fnc.numtext(smm)
         'start date for query (begining of lag value including average period)

         Set MyRecordset = New ADODB.Recordset
         MySql = sql.sqlVSers(mm, yy, qtable, qcode, sdate1)
         MyRecordset.Open MySql, MyConnect, adOpenStatic, adLockReadOnly

         Do Until MyRecordset.EOF     'Loop to end and enter required values
         cur_value = cur_value + MyRecordset(qcode)
         MyRecordset.MoveNext
         Loop

         cur_value = cur_value / average_period
         MyRecordset.Close


     'STEP-C: Calculates the Requested % Change or Point Value.
     '===============================================================
     If compare_period = 0 Then
         ValueV = cur_value
     Else
         ValueV = cur_value / lag_value * 100 - 100
     End If

 End Function

由于我完全绕过了子程序的使用,因此与数据库的连接目前是作为工作簿助手程序完成的,如下所示。

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim filePath
filePath = ThisWorkbook.Path
If Right$(filePath, 1) <> "\" Then filePath = filePath & "\"
MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filePath & "rsdata.accdb;"
End Sub

问题是,这种更新过程不太理想。理想情况下,我想在菜单栏中放置一个自定义按钮(单击它时)将连接到数据库并重新计算给定工作表或工作簿中使用的所有用户定义函数。

请提供您的建议或指出以前可能做过类似事情的地方。

提前致谢。 JR。

1 个答案:

答案 0 :(得分:1)

您正试图将UDF用于他们不打算做的事情。他们 设计的内容就像其他单元格公式一样,并且当Excel决定它们需要时会被加工。

您有两个选择

  • 重新设计您的应用程序,以便不使用UDF(IMO最佳方式)
  • 修改您的UDF以仅响应您指定的触发器,例如点击按钮(IMO是一个肮脏的想法)

如何重新设计以避免UDF取决于OP中未披露的因素