【问题标题】:Writing to a worksheet from a VBA function从 VBA 函数写入工作表
【发布时间】:2020-03-16 03:09:51
【问题描述】:

我正在尝试将用户定义的 VBA 函数中的一些中间结果写入工作表。我已经测试了这个功能,它可以正常工作。我知道我无法从 UDF 修改/写入单元格,因此我尝试将相关结果传递给我希望随后能够写入电子表格的子程序。

很遗憾,我的方案不起作用,我正在努力思考这个问题。

Public Function f(param1, param2)
    result = param1 * param2
    call writeToSheet(result)
    f = param1 + param2
end

public sub writeToSheet(x)
    dim c as range
    c = range("A1")
    c.value = x
end 

我想在单元格 A1 中查看 param1 和 param2 的乘积。不幸的是,它并没有发生 - 子例程在尝试执行第一条语句时突然结束(c = range("A1") )。我做错了什么,我该如何解决?

如果根本不可能以这种方式写入电子表格,是否有其他方法可以存储中间结果以供以后查看?我的现实生活问题比我上面的程式化版本要复杂一些,因为我每次经过一个循环时都会生成一组新的中间结果,并希望将它们全部存储起来以供审查。

【问题讨论】:

  • Set c = Range("A1").
  • 您可以随时写入即时窗口或全局数组(您可以稍后阅读)
  • 考虑从子程序运行您的分析,而不是从工作表中驱动它。函数以这种方式工作得很好。只有当您从单元格公式中调用它们时,您才会有限制......按设计。
  • 如果您想要一个不那么不稳定的替代方案,而不是写入工作表,也许将数据写入文本文件。你甚至可以设置一个 application.ontime 调用来将文本文件中的数据加载到一个单元格(或范围)中。
  • 将 UDF 结果存储在全局字典中,并在 AfterCalculation 事件中输出,该事件在处理完所有 UDF 后触发,这就是为什么您可以在任何单元格中输出而不会违反。

标签: excel vba user-defined-functions subroutine


【解决方案1】:

这个想法可能对你有用。函数ParamProduct 调用SetProps 将两个参数写入自定义文档属性(从文件> 属性> 高级属性> 自定义 查看)。使用=ParamProduct(A1, A2)或=ParamProduct(123, 321)调用函数

Function ParamProduct(Param1 As Variant, _
                      Param2 As Variant) As Double

    Dim Fun As Double
    Dim Param As Variant
    Dim i As Integer

    Param = Param1
    For i = 1 To 2
        SetProp "Param" & i, Param
        Param = Param2
    Next i
    ParamProduct = Param1 + Param2
End Function

Private Sub SetProp(Pname As String, _
                    PropVal As Variant)
    ' assign PropVal to document Property(Pname)
    ' create a custom property if it doesn't exist

    Dim Pp As DocumentProperty
    Dim Typ As MsoDocProperties

    If IsNumeric(PropVal) Then
        Typ = msoPropertyTypeNumber
    Else
        Select Case VarType(PropVal)
            Case vbDate
                Typ = msoPropertyTypeDate
            Case vbBoolean
                Typ = msoPropertyTypeBoolean
            Case Else
                Typ = msoPropertyTypeString
        End Select
    End If

    On Error Resume Next
    With ThisWorkbook
        Set Pp = .CustomDocumentProperties(Pname)

        If Err.Number Then
            .CustomDocumentProperties.Add Name:=Pname, LinkToContent:=False, _
                                          Type:=Typ, Value:=PropVal
        Else
            With Pp
                If .Type <> Typ Then .Type = Typ
                .Value = PropVal
            End With
        End If
    End With
End Sub

使用此 UDF 将属性调回工作表。

Function GetParam(ByVal Param As String) As Variant
    GetParam = Propty(Param)
End Function

Private Function Propty(Pname As String) As Variant
    ' SSY 050 ++
    ' return null string if property doesn't exist

    Dim Fun As Variant
    Dim Pp As DocumentProperty

    On Error Resume Next
    Set Pp = ThisWorkbook.CustomDocumentProperties(Pname)

    If Err.Number = 0 Then
        Select Case Pp.Type
            Case msoPropertyTypeNumber
                Fun = CLng(Fun)
            Case msoPropertyTypeDate
                Fun = CDate(Fun)
            Case msoPropertyTypeBoolean
                Fun = CBool(Fun)
            Case Else
                Fun = CStr(Fun)
        End Select
        Fun = Pp.Value
    End If

下面的工作表函数有效(A6 的值为“Param2”) =GetParam("Param1")*GetParam(A6)

如果属性不存在,上面的代码将创建一个属性,如果存在则更改它的值。如果调用它来删除不存在的属性,则下面的子将删除现有属性并且不执行任何操作。您可以从上述子程序或函数之一调用它。

Private Sub DelProp(ByVal Pname As String)

    On Error Resume Next
    ThisWorkbook.CustomDocumentProperties(Pname).Delete
    Err.Clear
End Sub

【讨论】:

  • 感谢磨坊。我采用了 debug.print 的想法,创建了一个包含 5 个数字的字符串,然后将其打印出来。 dummystr = CStr(slope1) & ", " & CStr(intercept1) & ", " & CStr(slope2) & ", " & CStr(intercept2) & ", " & CStr(sse(i)) Debug.Print dummystr
  • 感谢您的反馈。使用属性,您可以将整个字符串或每个组件分别带回 Excel。如果您将 Application.Volatile 添加到 UDF,它将是实时的,就好像 UDF 实际上已写入工作表一样。
【解决方案2】:

谢谢大家。打印到即时窗口是迄今为止最简单的,但只允许我打印一个项目。因此,我将所有 5 个项目连接成一个字符串并将其打印在即时窗口中:

dummystr = CStr(slope1) & ", " & CStr(intercept1) & ", " & CStr(slope2) & ", " & CStr(intercept2) & ", " & CStr(sse(i)) Debug.Print dummystr

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2013-12-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-10-28
    • 2017-05-17
    相关资源
    最近更新 更多