求vba思路

于箱长

于箱长 发表于 2022-11-14 15:02
好像整复杂了，是不是这个意思

根据grf1973老师的思路，加了一个条件去掉重复科目

于箱长

笨鸟飞不高 发表于 2022-11-14 15:06

思路真棒，我可以借鉴一下，今天没有花了，回头补给您

陆离Lowry

大概懂了，就是把同A的借和贷的对应的科目给对调一下呗？

于箱长

陆离Lowry 发表于 2022-11-14 15:13
大概懂了，就是把同A的借和贷的对应的科目给对调一下呗？

是列示除了本行F列科目之外的其他科目

准提部林

Sub TEST_A1()
Dim Arr, xD, i&, T$, T1$, T2$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([o1], [a65536].End(3))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1) & InStr("_借貸", Arr(i, 15)): T2 = Arr(i, 6): T = T1 & T2
    If xD(T) = 0 Then xD(T1) = xD(T1) & "," & T2
    xD(T) = 1
Next i
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1) & InStr("_貸借", Arr(i, 15))
    Arr(i - 1, 1) = Mid(xD(T1), 2)
Next i
[r2].Resize(UBound(Arr) - 1) = Arr
End Sub

高个子

于箱长 发表于 2022-11-14 15:34
是列示除了本行F列科目之外的其他科目

专业的就是不一样

于箱长

高个子 发表于 2022-11-14 15:54
专业的就是不一样

啊？我是来学习思路的

Hontyu

学习下10楼老师的代码
Sub TEST()
    Dim i&, ar, br()
    Dim d: Set d = CreateObject("Scripting.Dictionary")
    ar = [A1].CurrentRegion
    ReDim br(1 To UBound(ar) - 1, 1 To 1)
    For i = 2 To UBound(ar)
        sKey = ar(i, 1) & "|" & ar(i, 15)
        If Not d.Exists(sKey) Then
           Set d(sKey) = CreateObject("Scripting.Dictionary")
        End If
        d(sKey)(ar(i, 6)) = Empty
    Next i
    For i = 2 To UBound(ar)
        If ar(i, 15) = "借" Then ar(i, 15) = "贷" Else ar(i, 15) = "借"
        sKey = ar(i, 1) & "|" & ar(i, 15)
        br(i - 1, 1) = Join(d(sKey).keys, "、")
    Next i
    [T2].Resize(UBound(br)) = br
End Sub

于箱长

各位老师关注一下示例中最后一行分录的借贷方的方向，这个科目对应科目应该是本年利润

Hontyu

于箱长 发表于 2022-11-14 19:34
各位老师关注一下示例中最后一行分录的借贷方的方向，这个科目对应科目应该是本年利润

这种多借多贷的,只能靠人工判断了,没办法一一对应