Запись на лист из функции VBA - PullRequest
Новая
       26

Запись на лист из функции VBA

0 голосов
/ 16 марта 2020

Я пытаюсь записать некоторые промежуточные результаты в определенной пользователем функции 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

Я хотел бы видеть произведение param1 и param2 в ячейке A1. К сожалению, этого не происходит - подпрограмма просто внезапно заканчивается, как только она пытается выполнить первый оператор (c = range ("A1")). Что я делаю не так, и как я могу это исправить?

Если просто невозможно записать в электронную таблицу таким образом, есть ли другой способ сохранить промежуточные результаты для последующего просмотра? Моя реальная проблема немного сложнее, чем моя стилизованная версия выше, так как я генерирую новый набор промежуточных результатов каждый раз, когда я go через al oop, и хочу сохранить их все для просмотра.

Ответы [ 2 ]

1 голос
/ 16 марта 2020

Эта идея может работать на вас. Функция 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 имеет значение of "Param2") =GetParam("Param1")*GetParam(A6)

Приведенный выше код создаст свойство, если оно не существует, или изменит его значение, если оно существует. Подпрограмма ниже удалит существующее свойство и ничего не сделает, если вызывается для удаления несуществующего свойства. Вы можете вызвать его из одной из вышеперечисленных подпрограмм или функций. 

Private Sub DelProp(ByVal Pname As String)

    On Error Resume Next
    ThisWorkbook.CustomDocumentProperties(Pname).Delete
    Err.Clear
End Sub
0 голосов
/ 16 марта 2020

Спасибо мельнице всем. Печать в ближайшее окно является самой простой, но позволяет мне печатать только один элемент. Поэтому я объединил все 5 элементов в одну строку и распечатал ее в ближайшем окне:

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

...