[求助]透视多重合并计算数据区用vba变量来咋写?

akk

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, SourceData:= _
    Array(Array("Sheet1!R7:R83", "项1"), Array("Sheet1!R89:R165", "项2"), Array( _
        "Sheet1!R171:R247", "项3"), ...（太长了中间省略若干）...))).CreatePivotTable TableDestination:="", TableName:="数据透视表5", DefaultVersion:= xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("数据透视表5").DataPivotField.PivotItems("计数项:值").Position = 1
在以上录制的"多重合并计算数据区域"宏里面
    Array(Array("Sheet1!R7:R83", "项1"), Array("Sheet1!R89:R165", "项2"), Array( _
    "Sheet1!R171:R247", "项3"), ...（太长了中间省略若干）...)))有多个每隔6行有个76行的数据区。现想精减为用vba变量来换掉以上冗长的语句。且运行到自行判断到最后有数据的76行数据区为止。

有劳大家帮忙，谢了！

蓝桥玄霜

试试先将各个区域赋值给数组Arr，然后用Arr(1)、Arr(2)...来代替"Sheet1!R7:R83"。

akk

QUOTE:

以下是引用蓝桥玄霜在2008-10-31 15:02:00的发言：
试试先将各个区域赋值给数组Arr，然后用Arr(1)、Arr(2)...来代替"Sheet1!R7:R83"。

谢版主。

"先将各个区域赋值给数组Arr"

我理解为还是要一个一个的数值区来赋值，变量瓶颈还在。

 

蓝桥玄霜

如果区域多，可用循环来解决。

没有附件不能测试。

akk

gGElxQGX.rar (32.92 KB, 下载次数: 4)

2008-11-1 15:21 上传

点击文件名下载附件
[求助]透视多重合并计算数据区用vba变量来咋写?

呵呵，考虑不周。现呈上附件。

[em06]

蓝桥玄霜

mAt2TAvZ.rar (43.78 KB, 下载次数: 32)

2008-11-2 15:32 上传

点击文件名下载附件
[求助]透视多重合并计算数据区用vba变量来咋写?
Sub yy()
Dim Arr(1 To 3), m%, n%, i%, col(1 To 3)
Dim Myr%, mCol%
n = 1
Sheet1.Activate
For i = 1 To 3
    m = n + 6: n = m + 76
    col(i) = Cells(m, "iv").End(xlToLeft).Column
    Arr(i) = "Sheet1!" & Range(Cells(m, 1), Cells(n, col(i))).Address(ReferenceStyle:=xlR1C1)
Next i
mCol = Application.Max(col)
Sheet3.Activate
[a1].Consolidate Arr, xlSum, True, True
Myr = [a65536].End(xlUp).Row
Cells(1, mCol + 1) = "总计"
Cells(Myr + 1, 1) = "总计"
Cells(2, mCol + 1).Formula = "=sum(rc4:rc[-1])"
Cells(2, mCol + 1).AutoFill Range(Cells(2, mCol + 1), Cells(Myr + 1, mCol + 1))
Cells(Myr + 1, 4).Formula = "=sum(r2c:r[-1]c)"
Cells(Myr + 1, 4).AutoFill Range(Cells(Myr + 1, 4), Cells(Myr + 1, mCol))
Columns("b:b").Delete shift:=xlToLeft
Range(Cells(1, 1), Cells(Myr + 1, mCol)).Borders.LineStyle = 1
Range(Cells(1, 1), Cells(1, mCol)).EntireColumn.AutoFit
End Sub

akk

谢谢蓝板！没想到会这么复杂，学习再学习

[em01]