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

Question

大家下午好，

我已经读了很长时间，但第一次发海报。我正在做一个项目，要求我在Excel中获取试算表数据，并将该数据格式化为"资产负债表"。

基本上，我将试算表数据放在一个工作表("数据"(中，资产负债表模板放在另一个工作表("资产负债表"(中

我需要将资产负债表从(">

数据"(表填充到("资产负债表"(。我很难弄清楚如何做到这一点

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

但是我在使这段代码健壮和灵活时遇到了麻烦，目前它被硬编码到资产负债表中的值。如何使此代码灵活，以便正确填充(例如，如果我向现金组添加了另一个"现金"帐户，则会将该金额添加到资产负债表中的"现金"行(

如果需要查看，这是文件。没有很多代码，所以任何帮助将不胜感激！

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

http://imgur.com/a/bYjUp

Answer 1

我还没有下载您的项目，但似乎您需要做的是为每种类型的帐户创建一个数组。为简单起见，假设您只有arrCash和arrResponsibility。 然后，您将用每个已知的 gl 代码填充数组。或者另一种方法是将 gl 代码列表保存在单独的电子表格中。现在是有趣的部分。您将遍历 excel 电子表格，并将每个代码与数组中的元素进行比较。如果比较等于 true，则将该数量添加到您的一个变量中。如果比较等于 false，则创建一个例程，该例程将需要添加 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