我现在有会计分录序时簿一个文件。
它的内容是下面这个样子，我现在需要先提取每张凭证的借贷会计科目，然后反写到每一行数据中。
这样做的目的在于按照每张凭证的借贷会计科目来对凭证进行业务分类，从而达到分析的目的。完成后我们可以做的有：
1.按照借贷科目对凭证进行分类将会更加准确。
2.分类之后可以直接关联每种类型中货币资金的去向，用更直接简单的方法来编制现金流量表。


现在添加了附件如下：


以下代码是我在VBA中用到的。能满足要求。
但我的数据源本身就是VFP，还请乡亲们帮忙提供解决思路或者解决方案，谢谢。

Sub 凭证一级科目提取()
    Dim br, cr(60000, 4), dc, dk, de, df, dw(60000, 1)
    br = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    bok1 = ActiveSheet.Name
    For xrow = 2 To UBound(br)
        If br(xrow, 10) = 0 Then
            方向 = "cr"
            Else: 方向 = "dr"
        End If
        If br(xrow, 2) & br(xrow, 3) <> dk Or xrow = UBound(br) Then
            Item = Item + 1
            If Item > 1 Then
                cr(Item - 1, 0) = dk    'key
                cr(Item - 1, 1) = dc    '科目
                cr(Item - 1, 2) = de    '摘要
                cr(Item - 1, 3) = df    '制单人
                dk = ""
                dc = ""
                de = ""
                df = ""
            End If
        End If
        dk = br(xrow, 2) & br(xrow, 3)
        If InStr(dc, 方向 & br(xrow, 23)) = False Then dc = dc & 方向 & br(xrow, 23)
        If InStr(de, Left(br(xrow, 5), 8)) = False Then de = Left(br(xrow, 5), 8)  '只要最后一个摘要。
        If InStr(df, Left(br(xrow, 12), 8)) = False Then df = df & Left(br(xrow, 12), 8)
    Next
    Sheets.Add
    Range(Cells(1, 1), Cells(Item, "e")) = cr
    [a1:d1] = Array("key", "科目", "摘要", "制单人")
    Cells.WrapText = False
    Sheets(bok1).Select
        For xx = 1 To UBound(cr)
            d(cr(xx, 0)) = cr(xx, 1)
        Next xx
        For yy = 2 To [a65536].End(xlUp).Row + 1
            dw(yy - 2, 0) = d(br(yy - 1, 2) & br(yy - 1, 3))
        Next yy
        Range(Cells(1, "ab"), Cells(UBound(br), "ab")) = Application.Index(dw, 0, 0)
        [ab1] = "凭证"
End Sub

[此贴子已经被作者于2018-11-22 20:54编辑过]

我自己想的思路是这样，首先创建一列用来记录每一行对应的科目，代码如下：

ALTER table te ADD COLUMN 科目 c(80)
UPDATE te SET 科目=IIF(dr=0,"dr","cr")-一级科目

运行代码后变成了下面这个结果。

[此贴子已经被作者于2018-11-22 16:34编辑过]

自己再进一步想到的代码便是：

ke =''
ce=''
DO WHILE not EOF()

    IF     会计期间-凭证字号=ke THEN 
        ce=ce-科目
    ELSE 
        REPLACE  kk WITH ce 
    ENDIF        
    ke =会计期间-凭证字号
skip
ENDDO 

仅仅只实现了部分希望的内容，而且还是一个错误的。我的希望是每一行都能填充我需要的内容。

[此贴子已经被作者于2018-11-22 16:49编辑过]

感谢你的回答，我的想法就是每一张凭证，我可以汇总出来这张凭证的借贷一级科目各是什么例如：“dr现金cr银行”等内容。然后把这些内容填写进入每一行分录中。

感谢大神sdta的答复，谢谢你！

 很抱歉没有表述清楚，现在编制一个excel再解释下：


合并凭证的excel档案在下面：

[此贴子已经被作者于2018-11-22 20:38编辑过]

太感谢sdta,完美的解决了这个问题。
用VFP的代码比VBA的代码简单多了。坚守VFP最后的阵地，我们一直用它。

以下是我自己编写的代码，思路是先建立一个数组J,
数组运行完成后可以看到具体的数据，J(1,1)数据的第一列存放会计期间-凭证字号，数组的第二列存放我们需要的凭证内容。
第一个问题：数组的65536行是我自己设置的，不知道怎么样让它可以自动按照实际的行数来收缩。
第二个问题：怎么让我的原始数据可以从数组中跟新第二列的值。

DECLARE j(65536,2)
SELECT * FROM 凭证 INTO TABLE te
ALTER table te ADD COLUMN 凭证 c(80)
UPDATE te SET 凭证=IIF(借方=0,'cr','dr')-一级科目
sw =''
c=''
item =0
CLOSE TABLES 
USE te 
GO TOP 
DO WHILE NOT EOF()
    IF 会计期间-凭证字号<>sw THEN 
        item =item+1
        j(item,1)=ALLTRIM(sw)
        j(item,2)=ALLTRIM(c)
        sw =''
        c=''
    ENDIF
    sw=会计期间-凭证字号
    IF !凭证$c THEN 
        c =c-凭证   &&凭证内容
    ENDIF
    SKIP

ENDDO

谢谢大家，已经找到答案，并且还新学习了不少内容。