在Excel VBA中评估和存储复杂表达式

时间:2016-10-22 15:41:39

标签: excel vba excel-vba

我正在制定一个会计VBA程序,它将日记帐分录发布到分类帐,然后生成试算表(即在分类帐中的“Bal。”后面的新工作表上打印出值)。为此,我需要一种方法将余额单元格的数字部分分配给变量或集合。不幸的是,当我使用Debug.Print时,我看到存储的唯一值是0(我正在使用Common Stock进行测试)。我的表达是:y = Application.Evaluate("=SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1])")其中y代表普通股的余额。如何将余额值正确存储在变量中?

Screen Recording

' TODO BE ABLE TO RUN MULTIPLE TIMES
' CHECK FOR POSTED MARK & START WRITING WHEN
' r = "one of the keys", or just creates new Ledger Worksheet every time

Sub MacCompileData()
Application.ScreenUpdating = False
Dim lastRow As Long, x As Long
Dim data, Key
Dim r As Range
Dim cLedger As Collection, cList As Collection
Set cLedger = New Collection

With Worksheets("Journal")
    lastRow = .Range("B" & .Rows.Count).End(xlUp).Row

    For x = 2 To lastRow
        Key = Trim(.Cells(x, 2))
        On Error Resume Next
        Set cList = cLedger(Key)
        If Err.Number <> 0 Then
            Set cList = New Collection
            cLedger.Add cList, Key
        End If
        On Error GoTo 0

        cLedger(Key).Add Array(.Cells(x, 1).Value, .Cells(x, 3).Value, .Cells(x, 4).Value)
        Worksheets("Journal").Cells(x, 5).Value = ChrW(&H2713)

    Next
End With

With Worksheets("Ledger")

    Dim IsLiability As Boolean
    Dim y As Integer

    For Each r In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))

        If r <> "" Then

        On Error Resume Next
        Key = Trim(r.Text)

        If Key = "LIABILITIES" Then
            IsLiability = True
        End If

        data = getLedgerArray(cLedger(Key))

        If Err.Number = 0 Then
            Set list = cLedger(Key)
            x = cLedger(Key).Count
            With r.Offset(2).Resize(x, 3)
                .Insert Shift:=xlDown, CopyOrigin:=r.Offset(1)
                .Offset(-x).Value = data

                If IsLiability Then
                    .Offset(0, 2).Resize(1, 1).FormulaR1C1 = "=""Bal. "" & TEXT(SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1]),""$#,###"")"

                    ' LOOK HERE FOR Y
                    y = Application.Evaluate("=SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1])")

                    Debug.Print "Common Stock Balance Equals "; y

                Else
                    .Offset(0, 1).Resize(1, 1).FormulaR1C1 = "=""Bal. "" & TEXT(SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1]),""$#,###"")"
                End If


                r.Offset(1).EntireRow.Delete
            End With
        End If

        On Error GoTo 0
        End If
    Next

End With
Application.ScreenUpdating = True

End Sub

Function getLedgerArray(c As Collection)
Dim data
Dim x As Long
ReDim data(1 To c.Count, 1 To 3)

For x = 1 To c.Count
    data(x, 1) = c(x)(0)
    data(x, 2) = c(x)(1)
    data(x, 3) = c(x)(2)
Next
getLedgerArray = data
End Function

1 个答案:

答案 0 :(得分:0)

这是我能够弄清楚的解决方案,但我不确定它是否是最有效的。在设置公式之前的行中,我将名为Range的{​​{1}}设置为将写入公式的单元格。然后,在将公式放入BalanceCell后,我使用Mid函数从单元格中获取字符串数值(因为“Bal。”的长度始终为5个字符)。

BalanceCell

ScreenRecording