当前位置: article > 正文

SAP接口编程之综合实例（一）：资产负债表方案 (转载：http://blog.csdn.net/stone0823 http://blog.csdn.net/stone0823/artic_csdn sap北河

作者：黑客灵魂 | 2024-06-22 13:06:52

踩

csdn sap北河

SAP 对法定的会计报表，比如资产负债表，损益表等，有多种实现方案。这里给出一个集成 Excel 的实现方案。实现方案的主要优点是用户的自由度比较大，可以灵活设置，而且基本实现了一次开发，不同项目只需要部署就能使用。

1. 资产负债表实现方法说明

在 Excel 中，使用 VBA 调用 SAP RFC 方法，导入公司代码下会计科目和科目汇总表（英文叫 Trial balance, 包括会计科目的期初余额、本期发生额和期末余额），自动保存到 Excel 工作表，导入的数据格式如下:

从SAP导入的数据格式

数据字段说明：

数据字段说明

在 Excel 中自定义相应函数，实现数据显示。比如我们要实现的 “资产负债表” 格式如下：

资产负债表（部分）

以【货币资金】为例，D7 单元格的公式：=AccAmount(BS_Source!B:B,K7,BS_Source!J:J)，AccAmount 是自定义的函数名，表示获取会计科目的期末余额。我们先不管这个函数参数是什么意思，总之是实现自动取数，文章后面会详细说明。

2. 数据通过 RFC 导入到 Excel

2.1 SAP 中自定义函数获取会计科目余额和发生额

SAP 提供的函数 BAPI_GL_GETGLACCPERIODBALANCES 只能提供单个科目的会计余额，我们要导入的是批量数据，所以需要自定义一个函数。写法可以多种，这里给出一个示例代码：


FUNCTION zbapi_getglaccperiodbalances.
*"----------------------------------------------------------------------
*"*"局部接口：
*"  IMPORTING
*"     VALUE(COMPANYCODE) LIKE  FAGLFLEXT-RBUKRS OPTIONAL
*"     VALUE(FISCALYEAR) LIKE  FAGLFLEXT-RYEAR OPTIONAL
*"     VALUE(PERIOD) LIKE  FAGLFLEXT-RPMAX OPTIONAL
*"     VALUE(CURRENCYTYPE) LIKE  BAPI1028_5-CURR_TYPE OPTIONAL
*"  EXPORTING
*"     VALUE(BALANCE_CARRIED_FORWARD) LIKE  BAPI1028_4-BALANCE
*"     VALUE(RETURN) LIKE  BAPIRETURN STRUCTURE  BAPIRETURN
*"  TABLES
*"      ACCOUNT_BALANCES STRUCTURE  ZBALANCES OPTIONAL
*"  EXCEPTIONS
*"      INIT_DATA
*"----------------------------------------------------------------------
 
  DATA: BEGIN OF lt_fag OCCURS 0,
          bukrs LIKE faglflext-rbukrs,  "公司代码
          ryear LIKE faglflext-ryear,   "会计年度
          racct LIKE faglflext-racct,   "会计科目
          drcrk LIKE faglflext-drcrk,   "借贷方
          hslvt LIKE faglflext-hslvt,
          hsl01 LIKE faglflext-hsl01,
          hsl02 LIKE faglflext-hsl02,
          hsl03 LIKE faglflext-hsl03,
          hsl04 LIKE faglflext-hsl04,
          hsl05 LIKE faglflext-hsl05,
          hsl06 LIKE faglflext-hsl06,
          hsl07 LIKE faglflext-hsl07,
          hsl08 LIKE faglflext-hsl08,
          hsl09 LIKE faglflext-hsl09,
          hsl10 LIKE faglflext-hsl10,
          hsl11 LIKE faglflext-hsl11,
          hsl12 LIKE faglflext-hsl12,
          hsl13 LIKE faglflext-hsl13,
          hsl14 LIKE faglflext-hsl14,
          hsl15 LIKE faglflext-hsl15,
          hsl16 LIKE faglflext-hsl16,
        END OF lt_fag,
 
        lt_ret LIKE zbalances OCCURS 0 WITH HEADER LINE.
 
  FIELD-SYMBOLS: <field>.
 
  DATA: lv_idx TYPE i,
        lv_times TYPE i,
        lv_int TYPE i,
        lv_rpmax(2) TYPE c,
        lv_fieldname TYPE string,
        lv_hslxx LIKE faglflext-hslvt,
        lv_waers LIKE t001-waers.
 
* 公司本位币
  SELECT SINGLE waers
    INTO lv_waers
    FROM t001
   WHERE bukrs = companycode.
 
  SELECT rbukrs AS bukrs
         ryear
         racct
         drcrk
         hslvt
         hsl01
         hsl02
         hsl03
         hsl04
         hsl05
         hsl06
         hsl07
         hsl08
         hsl09
         hsl10
         hsl11
         hsl12
         hsl13
         hsl14
         hsl15
         hsl16
    INTO TABLE lt_fag
    FROM faglflext
   WHERE rbukrs = companycode
     and ryear = fiscalyear.
 
  SORT lt_fag BY bukrs ryear racct drcrk.
  LOOP AT lt_fag.
    AT NEW racct.
      CLEAR lt_ret.
      lt_ret-comp_code = lt_fag-bukrs.
      lt_ret-gl_account = lt_fag-racct.
      lt_ret-fisc_year = lt_fag-ryear.
      lt_ret-fis_period = period.
      lt_ret-currency = lv_waers.
    ENDAT.
 
*   年初余额
    lt_ret-yr_begin_bal = lt_ret-yr_begin_bal + lt_fag-hslvt.
 
    IF period = 12.
      lv_times = 16.
    ELSE.
      lv_times = period.
    ENDIF.
 
*   期初余额
    lt_ret-per_begin_bal = lt_ret-per_begin_bal + lt_fag-hslvt.
    DO lv_times TIMES.
      IF sy-index >= lv_times.
        EXIT.
      ENDIF.
 
      MOVE sy-index TO lv_rpmax.
      SHIFT lv_rpmax RIGHT DELETING TRAILING space.
      OVERLAY lv_rpmax WITH '00'.
      CONCATENATE 'HSL' lv_rpmax INTO lv_fieldname.
      ASSIGN COMPONENT lv_fieldname OF STRUCTURE lt_fag TO <field>.
      MOVE <field> TO lv_hslxx.
 
      lt_ret-per_begin_bal = lt_ret-per_begin_bal + lv_hslxx.
    ENDDO.
 
    IF period = 12.
      lv_times = 5.
    ELSE.
      lv_times = 1.
    ENDIF.
 
*   期间发生额
    DO lv_times TIMES.
      lv_int = period + sy-index - 1.
      MOVE lv_int TO lv_rpmax.
      SHIFT lv_rpmax RIGHT DELETING TRAILING space.
      OVERLAY lv_rpmax WITH '00'.
      CONCATENATE 'HSL' lv_rpmax INTO lv_fieldname.
      ASSIGN COMPONENT lv_fieldname OF STRUCTURE lt_fag TO <field>.
      MOVE <field> TO lv_hslxx.
 
      IF lt_fag-drcrk = 'S'.
*       期间借方
        lt_ret-debits_per = lt_ret-debits_per + lv_hslxx.
      ELSE.
*       期间贷方
        lt_ret-credit_per = lt_ret-credit_per + lv_hslxx.
      ENDIF.
    ENDDO.
 
    AT END OF racct.
      APPEND lt_ret.
    ENDAT.
  ENDLOOP.
 
  LOOP AT lt_ret.
    lv_idx = sy-tabix.
 
*   期间发生额（借方+贷方）
    lt_ret-period_amt = lt_ret-debits_per + lt_ret-credit_per.
 
*   期末余额
    lt_ret-balance = lt_ret-per_begin_bal + lt_ret-period_amt.
 
    MODIFY lt_ret INDEX lv_idx.
  ENDLOOP.
 
  DELETE lt_ret WHERE yr_begin_bal = 0 AND per_begin_bal = 0 AND debits_per = 0 AND credit_per = 0.
 
  account_balances[] = lt_ret[].
ENDFUNCTION.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

函数名： zbapi_getglaccperiodbalances。函数的参数包括公司代码，年度，期间，币别，根据参数所确定的条件，输出这些科目的期初余额，本期发生额，期末余额。代码简单，不多解释，也不是本文的重点。但顺便提一句，SAP 系统 ABAP 的编码就这么多，不像其他解决方案，可能需要大量 ABAP 编码。

2.2 RFC SAP_Connection模块

从模块的角度给出代码。Excel 首先是SAP_Connection模块，负责连接 SAP 系统，登陆 (Logon) 和注销 (Logoff) 。


' 模块说明：
' 负责SAP的连接，连接成功后，SAPConnection对象保存连接的信息
 
Option Explicit
 
Dim sapLogon  As SAPLogonCtrl.SAPLogonControl
Public SAPConnection As SAPLogonCtrl.Connection
Public logonSuccessful As Boolean
 
 
Public Sub logon()
    logonSuccessful = False
 
    Set sapLogon = New SAPLogonControl
    Set SAPConnection = sapLogon.NewConnection()    
 
    Call SAPConnection.logon(0, False)
 
    If SAPConnection.IsConnected = tloRfcConnected Then
        logonSuccessful = True
        Exit Sub
    End If
End Sub
 
 
Public Sub Logoff()
    If SAPConnection Is Nothing Then
        Exit Sub
    End If
 
    SAPConnection.Logoff
    logonSuccessful = False
    Set SAPConnection = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

2.3 RFC 调用函数 zbapi_getglaccperiodbalances

调用 SAP zbapi_getglaccperiodbalances 函数，将数据写入工作表。
首先在 VBA 中实现 ABAP内表数据（函数的表参数）写入工作表的通用实现。考虑到代码效率，数据先在内存中处理后，一次性写到工作表：


' 模块说明：
' SAP FM的表参数类似internal table, 将数据输出值EXCEL工作表
 
Option Explicit
 
'--------------------------------------------------
' 将Table对象写入worksheet, 整体拷贝，速度优化
'--------------------------------------------------
Public Sub WriteTable(itab As SAPTableFactoryCtrl.Table, sht As Worksheet)
    Dim col As Long          ' column index
    Dim row As Long          ' row index
    Dim headerRange As Variant  '在Excel中根据itab的header大小，类型为Variant数组
    Dim itemsRange As Variant   '在Excel中根据itab的行数和列数，类型为Variant数组
 
    ' 清除cells的内容
    sht.Cells.ClearContents
 
    If itab.RowCount = 0 Then
        Exit Sub
    End If
 
    '-------------------------------------------------
    ' 取消Excel的屏幕刷新和计算功能以加快速度
    '-------------------------------------------------
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    '------------------------------
    ' 将Table的Header写入Worksheet
    '------------------------------
 
    ' 根据内表的列数，使用Range创建一个数组
    Dim headerstarts As Range
    Dim headerends As Range
    Set headerstarts = sht.Cells(1, 1)
    Set headerends = sht.Cells(1, itab.ColumnCount)
 
    headerRange = sht.Range(headerstarts, headerends).Value
 
    ' 将内表列名写入数组
    For col = 1 To itab.ColumnCount
        headerRange(1, col) = itab.Columns(col).Name
    Next
 
    ' 从数组一次性写入Excel，这样效率较高
    sht.Range(headerstarts, headerends).Value = headerRange
 
    '-------------------------------
    ' 将Table的行项目写入Worksheet
    '-------------------------------
 
    ' 根据内表的大小,使用Range创建数组
    Dim itemStarts As Range
    Dim itemEnds As Range
 
    Set itemStarts = sht.Cells(2, 1)
    Set itemEnds = sht.Cells(itab.RowCount + 1, itab.ColumnCount)
    itemsRange = itab.Data
 
    ' 一次性将数组写入Worksheet
    sht.Range(itemStarts, itemEnds).Value = itemsRange
 
    '---------------------------------
    ' 恢复Excel的屏幕刷新和计算
    '---------------------------------
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

然后是调用 zbapi_getglaccperiodbalances 函数，代码在sap_get_acc_period_bal模块：


' 模块说明：
' 调用RFC获取公司代码会计科目的余额，写入工作表
'
' v1.0, 2015-6-14 by Stone Wang
' V1.1, 2015-6-26 by Stone Wang
 
Option Explicit
 
Public Sub get_sap_acc_balances(cocd As String, fiscal_yr As String, period As String)
    ' 导入SAP科目余额，写入BS_Source工作表
 
    Dim sapFunctions As SAPFunctionsOCX.sapFunctions
    Dim sapFunction As Object
    Dim acBalanceTable As Object
 
    ' 写入的工作表
    Dim sht As Worksheet
    Set sht = BSSource
 
    If logonSuccessful = False Then Exit Sub
 
    Set sapFunctions = CreateObject("SAP.FUNCTIONS") ' Use function to call BAPI
    Set sapFunctions.Connection = SAPConnection
 
    On Error GoTo err1:
    Set sapFunction = sapFunctions.Add("ZBAPI_GETGLACCPERIODBALANCES")
 
    ' Function import parameters
    sapFunction.Exports("COMPANYCODE").Value = cocd       'Company code
    sapFunction.Exports("FISCALYEAR").Value = fiscal_yr   'Fiscal year
    sapFunction.Exports("PERIOD").Value = period
    sapFunction.Exports("CURRENCYTYPE").Value = "10"      'Currency type
 
    ' Function table parameters
    Set acBalanceTable = sapFunction.Tables("ACCOUNT_BALANCES")
 
    If sapFunction.Call = True Then
        If acBalanceTable.RowCount > 0 Then
            sht.Activate
            '将internal table写入工作表
            Call WriteTable(acBalanceTable, sht)
        Else
            sht.Activate
            sht.Cells.ClearContents
            sht.Range("A1").Value = "没有数据被导入，数据源可能为空!"
        End If
    End If
 
    Set acBalanceTable = Nothing
    Set sapFunctions = Nothing
    Set sapFunction = Nothing
 
err1:
    If Err.Number = 1001 Then
        MsgBox "远程调用错误，请检查SAP中是否存在函数ZBAPI_GETGLACCPERIODBALANCES，是否允许远程调用等。", _
            vbExclamation
        Exit Sub
    End If
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

另外，因为 Excel 自定义函数需要用到会计科目，从速度上考虑，把会计科目列表存放在一个工作表中，方便后续函数调用。会计科目列表调用
SAP 的 BAPI 来实现，这里直接从刚才导入的会计科目余额中提取，代码放在 account_gl_list模块中：


' 模块说明：
' 从COASheet工作表获取公司代码下所有的会计科目清单
' 在UDF中，需要在会计科目的范围中循环，根据公司代码的科目清单，目的是提高效率
 
Option Explicit
 
 
Public Sub Generate_GL_List()
    ' 根据BS_Source的科目，产生会计科目清单，剔除重复项（如果有的话）
    ' 数据存放在GLList工作表中
 
    Dim row_count As Integer
    row_count = BSSource.UsedRange.rows.count
 
    ' 如果没有数据，则不处理
    If row_count <= 1 Then Exit Sub
 
    With GLListSheet
        ' 清除之前的数据
        .Cells.ClearContents
 
        ' 数据拷贝
        .Range("A1:A" & row_count + 1).Value = BSSource.Range("B1:B" & row_count + 1).Value
 
        ' 消除重复项
        .Range("A:A").RemoveDuplicates
 
        ' 根据会计科目排序
        .Columns("A:A").Sort key1:=.Range("A:A"), order1:=xlAscending, Header:=xlYes
    End With
End Sub
 
 
Public Function get_gl_count() As Integer
    '------------------------------------------
    ' 获取会计科目的数量
    ' 会计科目根据BS_Source导入的数据加工而得
    '------------------------------------------
 
    Dim count As Integer
    '因为有表头，实际的会计科目数减一
    count = GLListSheet.UsedRange.rows.count - 1
 
    get_gl_count = count
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

2.4 用户操作界面设计

使用一个Excel工作表作为录入界面，执行上面的会计科目余额导入程序。

用户界面

2.5 导入数据的代码

当用点击【更新数据源】按钮，执行下面的代码，导入会计科目余额，至此，跟 SAP 数据交互完成。


' 模块说明：
' 从SAP系统导入会计科目余额
 
' Version 1.0, 2015-6-14 by Stone Wang
 
Option Explicit
 
Public Sub import_sap_data()
    ' 校验（input validation)
    If Range("COMPANY_CODE").Value = "" Then
        MsgBox "请输入公司代码.", vbExclamation
        Exit Sub
    End If
 
    If Range("FISCAL_YEAR").Value = "" Then
        MsgBox "请输入会计年度.", vbExclamation
        Exit Sub
    End If
 
    If Range("PERIOD").Value = "" Then
        MsgBox "请输入会计期间.", vbExclamation
        Exit Sub
    End If
 
    ' 如果没有连接到SAP，连接SAP
    If logonSuccessful <> True Then
        Call logon
    End If
 
    ' 导入会计科目余额
    Dim cocd As String
    Dim fiscal_year As String
    Dim period As String
 
    cocd = CStr(Range("COMPANY_CODE").Value)
    fiscal_year = CStr(Range("FISCAL_YEAR").Value)
    period = CStr(Range("PERIOD").Value)
 
    Call get_sap_acc_balances(cocd, fiscal_year, period)
 
    ' 根据BS_Source产生科目清单
    ' 将会计科目清单写入GLList工作表
    Call Generate_GL_List   
 
    Application.Calculate
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

3. Excel 自定义函数

我打算自定义的函数叫做 AccAmount，是对 Excel SumIfs 函数的包装和功能增强。

SumIfs 函数的语法大体如下：

SumIfs(rangeA, criteria, rangeB)
根据 criteria（条件），在 rangeA 中找到相同的数据，然后将 rangeB 中对应行的数据加总，并作为返回值。

增强的原因是使用 SumIfs 函数，只能处理一个科目，因为资产负债表每个数据项可能来自多个科目，所以需要对这个函数进行修改，使得能处理多个科目。

我对资产负债表的数据项数据来源，定义了一种范围表达的格式。在科目范围中，用【分号】表示分隔的科目，用【..】表示连接的科目。举例如下：


- 1001000000..1099999999：表示 1001 开头的科目，即 1001000000 至
 1099999999
- 2241000000..2241999999;2703000000..2703999999：表示2241开头的科目以及2703开头的科目1
2
3

有了这个定义格式，我们就实现 AccAmount() 函数：

AccAmount(rangeA, accCriteria, rangeB)1

根据 accCriteria（会计科目条件）在 rangeA 中找到对应科目，然后将rangeB 中对应行的单元格数据加总，并将汇总的数据作为返回值。

3.1 科目范围分解为会计科目数组

刚才所述的会计科目范围，我们需要将其分解为单个的科目，存放在数组中，代码放在 account_split 模块之中：


'模块说明：
'会计科目的范围用分号表示不连续的范围，用..表示连续的范围
'会计科目范围分解出具体的会计科目，先根据分号分割，再从连续的科目中分解
'为了提高效率，循环的时候，读取公司代码的实际科目清单
 
' Verion 1.1:
' Account_resolution函数增加了对输入参数为空的判断
 
Option Explicit
 
 
Private Function split_account_by_semicolon(account_range As String) As String()
    '-------------------------------------------
    ' 将科目范围根据"分号"分解，然后放在数组中
    ' 数组中每一个item, 可能是单个科目，也可能是多个科目
    '-------------------------------------------
 
    Dim acc_array() As String
    acc_array = Split(account_range, ";") ' split函数返回的数组从0开始
 
    ' 逗号分割的每一个数组元素前后可能存在空格，将空格去掉
    Dim i As Integer
    For i = LBound(acc_array) To UBound(acc_array)
        acc_array(i) = Trim(CStr(acc_array(i)))
    Next
 
    split_account_by_semicolon = acc_array
End Function
 
 
Private Function split_continous_account(continous_acc As String) As String()
    '将会计科目根据..进行分解
    '..表示连续的科目范围
    '如果有.., 但未找到合适科目，返回#EmptyForXXX#
 
    'acc_count: 会计科目数量
    Dim acc_count As Integer
    acc_count = get_gl_count()
 
    Dim acc_list() As String
    If acc_count >= 1 Then
        ReDim acc_list(1 To acc_count)
    Else
        ReDim acc_list(1 To 1)
    End If
 
    Dim dot_pos As Integer  ' position of double dots 双点的位置
    dot_pos = InStr(continous_acc, "..")    ' 查找 ".." ，返回位置
 
    Dim lower_acc As String
    Dim upper_acc As String
 
    ' 一共需要处理三种情况：
    ' 1) 有..号，有科目被选择
    ' 2) 有..号，没有科目被选择
    ' 3) 没有..号，表示单个科目
    If dot_pos > 0 Then ' Found
        lower_acc = Left(continous_acc, dot_pos - 1)
        upper_acc = Right(continous_acc, Len(continous_acc) - dot_pos - 1)
 
        Dim account_range As Range
        Set account_range = GLListSheet.Range("A2:A" & acc_count + 1)
 
        Dim i As Integer
        Dim item As Variant
        Dim temp_acc As String
 
        i = 1  ' cocd_coa下标从1开始
        For Each item In account_range
            temp_acc = CStr(item)
            If temp_acc >= lower_acc And temp_acc <= upper_acc Then
                acc_list(i) = CStr(item)
                i = i + 1
            End If
 
            ' 确保会计科目表示按科目大小排序的
            If temp_acc > upper_acc Then
                Exit For
            End If
        Next
 
        If i > 1 Then ' i > 1表示有科目包括在其中
            ReDim Preserve acc_list(1 To i - 1)
        Else ' 表示没有科目被选择
            ReDim Preserve acc_list(1 To 1)
            acc_list(1) = "#EmptyFor" & continous_acc & "#" ' 没有找到科目,empty错误
        End If
    Else
        ReDim acc_list(1 To 1)
        acc_list(1) = continous_acc
    End If
 
    split_continous_account = acc_list
End Function
 
 
Public Function accounts_resolution(acc_range As String) As String()
    '----------------------------------------------------
    ' 根据科目范围，将范围分解为单个会计科目，放在数组中
    '----------------------------------------------------
 
    ' account_array()表示所有范围内科目，函数最后作为返回值
    Dim account_array() As String
 
    ' 先判断参数acc_range是否为空
    If Len(acc_range) = 0 Then
        ReDim account_array(1 To 1)
        account_array(1) = "#Empty#"
 
        accounts_resolution = account_array
        Exit Function
    End If
 
    ' 如果参数acc_range不为空，正常处理
    Dim count As Integer
    count = get_gl_count()
    If count > 1 Then
        ReDim account_array(1 To count)
    Else
        ReDim account_array(1 To 1)
    End If
 
 
    ' 先根据分号进行分解，分解后每一项表示单一科目或连续的科目
    Dim continous_acc() As String
    continous_acc = split_account_by_semicolon(acc_range)
 
    Dim i As Integer
    i = 1
 
    Dim item As Variant
    For Each item In continous_acc
        ' 再将连续的科目分解为具体的会计科目
        Dim acc_in_continuous_rng() As String
        acc_in_continuous_rng = split_continous_account(CStr(item))
 
        Dim acc As Variant
        For Each acc In acc_in_continuous_rng
            account_array(i) = CStr(acc)
            i = i + 1
        Next
    Next
 
    ' split_continuous_account()至少返回一个值
    ' 没有分解成功返回：#EmptyForXXX#, i的值一定会>=2, 所以不用判断i的大小
    ReDim Preserve account_array(1 To i - 1)
 
    accounts_resolution = account_array
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

代码说明

split_account_by_semicolon 函数，用于将科目范围中有分号的分解，并存放在一个数组之中
split_continous_account 函数，用于将连续的科目分解，结果存放在数组中
accounts_resolution 函数，综合上面的两个函数，对科目范围进行分解，并将结果存放在数组中

3.2 定义 AccAmount 函数供用户使用

将会计科目范围中的科目，循环调用 SumIfs 函数，结果加总，并作为返回值。


' @Author: Stone Wang
' @version 1.0
' @date: 2015-6-14
'
' 模块说明：
' 自定义函数，获取科目在某一列的合计，该函数是对EXCEL SUMIFs函数的增强
 
Option Explicit
 
Public Function AccAmount(ByVal acc_range As Range, _
                          ByVal acc_criteria As String, _
                          ByVal sum_range As Range) As Double
 
    ' 获取account期间的余额
    ' acc_range: account range
    ' acc_criteria: account criteria
    ' sum_range: sum range
 
    Dim result As Double
 
    Dim acc_array() As String
    acc_array = accounts_resolution(acc_criteria)
 
    Dim item As Variant
    Dim current_acc As String
    For Each item In acc_array
        current_acc = CStr(item)
 
        If Len(current_acc) > 0 Then
            result = result + _
                WorksheetFunction.SumIfs(sum_range, acc_range, current_acc)
        End If
    Next
 
    AccAmount = result
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

3.3 AccAmount 函数使用方法说明

设置专门的数据源定义区，比如货币资金，设置科目范围如下：

货币资金科目范围

并且将 1001000000..1099999999 所在的单元格定义一个名称为 CASH，这样在资产负债表的货币资金行中，使用如下公式：

=AccAmount(BS_Source!B:B,CASH,BS_Source!J:J)1

表示根据 CASH 单元格的科目范围（即 1001000000 至 1099999999），从 BS_Source 工作表的 B 列找到科目范围中有的科目，将相应行的 J 列数据汇总。

这样，定义了所有科目的公式之后，资产负债表就做好了。因为函数是给用户使用的，用户可以自由定义报表的各种细节，灵活性就非常好，自动化程度也高。

我曾在两个 SAP 实施项目中使用了这种方法来实现资产负债表、损益表和现金流量表。如果用户接受 Excel 作为数据展示的平台，我们可以用这个思路实现很多报表。

声明：本文内容由网友自发贡献，不代表【wpsshop博客】立场，版权归原作者所有，本站不承担相应法律责任。如您发现有侵权的内容，请联系我们。转载请注明出处：https://www.wpsshop.cn/w/黑客灵魂/article/detail/746596