以两图表例为例，问透视表对多表格式有什么要求。

ning84

Excel 如何汇总多表-Excel数据透视表-ExcelHome技术论坛 -  http://club.excelhome.net/thread-1310482-1-1.html



想用透视功能实现下面多表合一，没有成功。现在采用的是VBA方法。
请问，透视表的多表合一,对多表有什么要求。

1. Private Sub DEL()
   
2.    Dim RngArr(3) As Range
   
3.    Dim Rng As Range, oRng As Range
   
4.    Dim oRng1 As Range, oRng2 As Range
   
5.        ''
   
6.        Set Rng = Range("A:F")
   
7.        With Rng
   
8.            .ClearContents
   
9.            .UnMerge
   
10.            .Orientation = 0
    
11.            .Font.Size = 10
    
12.            .Borders.LineStyle = xlNone
    
13.        End With
    
14.        ''
    
15.        Set Rng = Cells(2, "I").CurrentRegion
    
16.        Set RngArr(0) = Rng
    
17.        ''Debug.Print Rng.Address
    
18.        Set Rng = Rng(2, 1).Resize(Rng.Rows.Count - 1, 1)
    
19.    Dim ii, nn, nn1
    
20.        For ii = 2 To 4
    
21.            Set RngArr(ii - 1) = Range(Rng(, ii).Formula).CurrentRegion
    
22.            'Debug.Print RngArr(ii - 1).Address
    
23.        Next ii
    
24.        rr = 3
    
25.        nn = RngArr(0).Rows.Count
    
26.        nn1 = Rng.Rows.Count
    
27.        ''
    
28.    Dim Row: Row = 2
    
29.        For ii = 0 To nn
    
30.            Set Rng = Cells(Row, 1)
    
31.            For kk1 = 0 To UBound(RngArr)
    
32.                Set oRng = RngArr(kk1)
    
33.                'Debug.Print oRng.Address
    
34.                If kk1 = 0 Then
    
35.                   Set oRng1 = Cells(Row + 1, 1).Resize(, RngArr(1).Columns.Count + 1)
    
36.                   ''
    
37.                   With oRng1
    
38.                       .MergeCells = True
    
39.                       .Borders.LineStyle = xlContinuous
    
40.                       .HorizontalAlignment = xlCenter
    
41.                      
    
42.                   End With
    
43.                   oRng1 = "= " & oRng(ii + 2, 1).Address
    
44.                   ''
    
45.                   Set oRng2 = Cells(Row + 2, 1).Resize(UBound(RngArr) * 2, 1)
    
46.                   With oRng2
    
47.                       .MergeCells = True
    
48.                       .Orientation = 90
    
49.                       .Borders.LineStyle = xlContinuous
    
50.                   End With
    
51.                   oRng2 = "= " & oRng(ii + 2, 1).Address
    
52.                   Set oRng1 = oRng1.Resize(oRng2.Rows.Count + 1, oRng1.Columns.Count)
    
53.                   oRng1.Borders.LineStyle = xlContinuous
    
54.                   Row = Row + 2
    
55.                Else
    
56.                   For kk = 2 To 2
    
57.                      For jj = 1 To oRng.Columns.Count
    
58.                         If oRng(kk, jj) <> "" Then
    
59.                           Cells(Row, jj + 1) = "= " & oRng(kk, jj).Address
    
60.                         End If
    
61.                         Cells(Row + 1, jj + 1) = "= " & oRng(ii + 3, jj).Address
    
62.                      Next jj
    
63.                      Row = Row + 1
    
64.                   Next kk
    
65.                   Row = Row + 1
    
66.                End If
    
67.            Next kk1
    
68.            'Row = Row - 1
    
69.        Next ii
    
70. End Sub
    

复制代码