如何生成明细账

潘悠然

如何生成明细账

鄂龙蒙

1. Option Explicit
   
2. Dim ar
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.     If Target.Address <> "$E$2" Then Exit Sub
   
5.     Dim sName$, br(), sa, i, x, j
   
6.     ReDim br(1 To UBound(ar), 1 To 8)
   
7.     Range("b3").CurrentRegion.Offset(2).ClearContents
   
8.     sName = Target.Value
   
9.     sa = Array(3, 4, 7, 10, 16, 17)
   
10.     x = 1
    
11.     br(1, 4) = "期初余额"
    
12.     br(1, 8) = 0
    
13.     For i = 3 To UBound(ar)
    
14.         If ar(i, 13) & "-" & ar(i, 14) = sName Then
    
15.             x = x + 1
    
16.             For j = 0 To 5
    
17.                 br(x, j + 1) = ar(i, sa(j))
    
18.             Next
    
19.             br(x, 8) = br(x - 1, 8) + br(x, 5) - br(x, 6)
    
20.         End If
    
21.     Next
    
22.     Range("b4").Resize(x, 8) = br
    
23. End Sub
    
24. Private Sub Worksheet_Activate()
    
25.     Dim d As Object, i&
    
26.     Set d = CreateObject("Scripting.Dictionary")
    
27.     ar = Sheet2.UsedRange
    
28.         For i = 3 To UBound(ar)
    
29.             If ar(i, 13) <> "" Then d(ar(i, 13) & "-" & ar(i, 14)) = ""
    
30.         Next
    
31.         With Range("E2").Validation
    
32.             .Delete
    
33.             .Add 3, 1, 1, Join(d.keys, ",")
    
34.         End With
    
35. End Sub
    

复制代码

鄂龙蒙

代码要审核！！！！！！

鄂龙蒙

鄂龙蒙