求SQL行转列生成多栏帐

fzlhb

求SQL行转列生成多栏帐,我想这样生成的多栏帐速度会更快，但我不会，求大神们帮帮忙！！！

鄂龙蒙

楼主【一级科目】如《管理费用》，怎么与【明细科目】（子目）对应？

fzlhb

鄂龙蒙 发表于 2018-9-15 10:58
楼主【一级科目】如《管理费用》，怎么与【明细科目】（子目）对应？

在 记帐凭证 这张表里 一级科目如 管理费用 它的 子目有 差旅费 办公费 邮电费        招待费 等，它们在同一列的不同行上。现在如果要做一个 管理费用 的 多栏帐，将同一列的不同行的 子目 （差旅费 办公费 邮电费 招待费等）生成 多栏帐的 列，并生成多栏帐,

fzlhb

效果图如下！！！！！！！！！！！！！

fzlhb

我想用SQL生成以上的效果！！！求大神助我！！

鄂龙蒙

1. Sub 生成多栏帐()
   
2.     Dim d, arr, ar, br(), m, i, j, s
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.    [A6:S10000] = Empty
   
5.    arr = Range("F5:S5")
   
6.     ar = Sheet1.UsedRange
   
7.         For i = 4 To UBound(ar)
   
8.             If ar(i, 7) = Range("A3") Then
   
9.                 s = ar(i, 4) & ar(i, 7)
   
10.                 If d(s) = "" Then
    
11.                     m = m + 1
    
12.                     ReDim Preserve br(1 To 19, 1 To m)
    
13.                     d(s) = m
    
14.                     For j = 1 To 5
    
15.                         br(j, m) = ar(i, j)
    
16.                     Next
    
17.                     For j = 1 To UBound(arr, 2)
    
18.                         If ar(i, 8) = arr(1, j) Then br(j + 5, m) = ar(i, 12)
    
19.                     Next
    
20.                 End If
    
21.             End If
    
22.         Next
    
23.     [A6].Resize(m, 19) = Application.Transpose(br)
    
24.    Set d = Nothing
    
25. End Sub

复制代码

鄂龙蒙

1. Sub 生成多栏帐()
   
2.     Dim d, arr, ar, br(), m, i, j, s
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.    [A6:S10000] = Empty
   
5.    arr = Range("F5:R5")
   
6.     ar = Sheet1.UsedRange
   
7.         For i = 4 To UBound(ar)
   
8.             If ar(i, 7) = Range("A3") Then
   
9.                 s = ar(i, 4) & ar(i, 7)
   
10.                 If d(s) = "" Then
    
11.                     m = m + 1
    
12.                     ReDim Preserve br(1 To 19, 1 To m)
    
13.                     d(s) = m
    
14.                     For j = 1 To 5
    
15.                         br(j, m) = ar(i, j)
    
16.                     Next
    
17.                     For j = 1 To UBound(arr, 2)
    
18.                         If ar(i, 8) = arr(1, j) Then br(j + 5, m) = ar(i, 12)
    
19.                     Next
    
20.                     If ar(i, 8) = "结转" Then br(19, m) = ar(i, 15)
    
21.                 Else
    
22.                     For j = 1 To UBound(arr, 2)
    
23.                         If ar(i, 8) = arr(1, j) Then br(j + 5, d(s)) = br(j + 5, d(s)) + ar(i, 12)
    
24.                     Next
    
25.                     If ar(i, 8) = "结转" Then br(19, d(s)) = br(19, d(s)) + ar(i, 12)
    
26.                 End If
    
27.             End If
    
28.         Next
    
29.     [A6].Resize(m, 19) = Application.Transpose(br)
    
30.    Set d = Nothing
    
31. End Sub

复制代码

鄂龙蒙

生成多栏帐.rar (78.46 KB, 下载次数: 11)

2018-9-15 11:39 上传

点击文件名下载附件

microyip

一条TRANSFORM语句应该可以解决问题啊