用于从试算表数据填充资产负债表的VBA代码

Question

大家下午好，

我已经是一个很长时间的读者，但第一次张贴。我正在做一个项目，要求我在Excel中获取试算表数据，并将这些数据格式化为“资产负债表”。

基本上，我在一个工作表(“数据”)中有试算表数据，在另一个表(“资产负债表”)中有资产负债表模板。

我需要将资产负债表从(“数据”)表填充到(“资产负债表”)。我想不通怎么做这件事。

我有一个我记录的第一个宏，它按账号格式化试算表数据，第二个宏将每组帐户合计(例如，所有的现金账户都在资产负债表的一行上相加)。

但我很难让这段代码变得健壮和灵活，目前它很难编码到资产负债表中的值。我如何使这段代码变得灵活，使其正确填充(例如，如果我将另一个“现金”帐户添加到现金组，它会将该金额添加到资产负债表中的“现金”行)。

这是文件，如果需要查看它。不是很多的代码，所以任何帮助都是非常感谢的！

http://s000.tinyupload.com/?file_id=22382427361802516291

http://imgur.com/a/bYjUp

Answer 1

我还没有下载你的项目，但似乎你需要做的是为每种类型的帐户创建一个数组。为了简单起见，我们假设你只有arrCash和arrLiability。然后，您可以用每个已知的gl code.or填充数组。另一种方法是在单独的电子表格中保留gl代码的列表。现在有趣的部分来了。您将遍历excel电子表格，并将每个代码与数组中的元素进行比较。如果比较结果为真，则将该值与您的一个变量相加。如果比较结果为假，则创建一个例程，对需要添加gl代码的数组进行重调整，然后将该gl代码添加到该数组中。或者添加到那个独立的电子表格中。在将新的gl代码添加到数组中之后，您需要将该数量添加到它的相应变量中。在完成所有计算后，您将使用变量中的amoubts更新资产负债表。很简单，对吧？

Answer 2

以下函数接受逗号分隔的值列表(数据表中a列的值)，并将对数据表中与提供的值匹配的所有行求和。

例如：?getSum("10300-000,10303-000") = 433094.74

Public Function getSum(ByVal Search As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim List() As String: List = Split(Search, ",")
Dim ListSize As Integer: ListSize = UBound(List)
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim Match As Integer
Dim Matched As Boolean

Dim Result As Double: Result = 0

Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2

Row = 1

Do
    Matched = False
    For Match = 0 To ListSize
        If Values(Row, 1) = List(Match) Then
            Matched = True
            Exit For
        End If
    Next Match

    If Matched = True Then
        Result = Result + CDbl(Values(Row, 3))
    End If

    If Row >= Rows Then
        Exit Do
    Else
        Row = Row + 1
    End If
Loop

getSum = Result

End Function

已更新以允许帐户范围而不是列表

Public Function getSum2(ByVal sFirst As String, ByVal sLast As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim First As Long: First = CLng(Left(sFirst, 5))
Dim Test As Long
Dim Last As Long: Last = CLng(Left(sLast, 5))
Dim Result As Double: Result = 0

Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2

Row = 1

Do
    Test = CLng(Left(Values(Row, 1), 5))

    If Test >= First And Test <= Last Then
        Result = Result + CDbl(Values(Row, 3))
    End If

    If Row >= Rows Then
        Exit Do
    Else
        Row = Row + 1
    End If
Loop

getSum2 = Result

End Function