在前一篇SSRS report builder的示例中，通过一些小设置就能轻松实现Web报表组合字段的展开与折叠，这里，受这个特性启发，运用VBA代码，在Excel中设计一个类似功能的示例，实现：

1）自动组合地区、产品，默认按小计折叠显示（图一），优点是节省手工设组合行的时间，并支持动态数据。 

2）按地区条件实现筛选（图二），之前有几个用公式实现筛选的示例，实现上有些复杂，VBA可简化许多。

3）报表区域实现保护，即只读，不可编辑。Excel设了保护后，组合展开/折叠（+/-）也被保护了，需使用一个技巧，保护报表数据的同时解除组合展开/折叠的保护。

环境：Excel 2010

预备知识：Excel组合功能（group/ungroup/outline等）

1 示例一： 自动组合地区、产品，默认显示各地区产品销售小计

图一：

http://s11/middle/62c0483cg97e5d99d967a&690VBA示例（自动组合\筛选\保护）" TITLE="【软件】3个Excel VBA示例（自动组合\筛选\保护）" />

1）设计一个数据表，包含地区销售小计，产品销售小计及各产品子类的销售额，例如图二所示。

2）在模块（Module1）中，设计一个名为DatarowsGroup的过程，两个循环段分别实现按地区组合行，再按产品组合行，并以小计级别（级别2）默认显示。

Sub DatarowsGroup()
    'Author       : http://blog.sina.com.cn/lightonlife
    'Macro purpose: automatic to group region and product category data

    Dim i As Integer
    Dim j As Integer
    Dim rowA As Integer
    Dim rowB As Integer
   
    rowA = 4
    rowB = 4
   
    Application.ScreenUpdating = False
    Application.StatusBar = ""
    
    For i = 4 To Sheets("Report").UsedRange.Rows.count
        If IsEmpty(Sheets("Report").Range("A" & i).Value) = False Then
            If Right(Sheets("Report").Range("A" & i).Value, 5) = "Total" And Sheets("Report").Range("A" & i).Value <> "Grand Total" Then
                Sheets("Report").Range("A" & rowA & ":A" & i - 1).Rows.group
                rowA = i + 1
            End If
        End If
    Next i
   
    For j = 4 To Sheets("Report").UsedRange.Rows.count
        If IsEmpty(Sheets("Report").Range("B" & j).Value) = False Then
            If Right(Sheets("Report").Range("B" & j).Value, 5) = "Total" Then
                Sheets("Report").Range("B" & rowB & ":B" & j - 1).Rows.group
                rowB = j + 1
            End If
        End If
    Next j
   
    Sheets("Report").Outline.ShowLevels RowLevels:=2 
End Sub

3）在模块（Module1）中，设计一个名为RemoveDatarowsGroup的过程，清除所有的组合，关键代码：

    Sheets("Report").Range("A2").ClearOutline
4）在thisWorkbook workbook open事件中，调用这两个模块过程，实现每次打开Excel文件，自动显示地区、产品销售小计。

Private Sub Workbook_Open()  
    Call RemoveDatarowsGroup
    Call DatarowsGroup
 End Sub

2 示例二：使用VBA代码按地区条件筛选销售信息

图二：

http://s1/middle/62c0483cg759714a7d3d0&690VBA示例（自动组合\筛选\保护）" TITLE="【软件】3个Excel VBA示例（自动组合\筛选\保护）" />

1）设计一个地区（Region）下拉菜单，作为筛选条件，如何实现，请参阅相关博文。

2）在这个下拉菜单的change事件中，编写下列代码，显示符合条件/隐藏不符合条件的行记录是VBA实现筛选的基本思路。这段代码大意是：先隐藏报表数据区所有行记录，如果选全部，则显示所有隐藏的行记录，如果选某个地区条件，则显示该地区第一条至最后一条的记录（由条件语句控制）。

Private Sub ComboBox1_Change()
    'Author       : http://blog.sina.com.cn/lightonlife
    'Macro purpose: filter based on region dropdown
   
    Dim i As Integer
    Dim strCategory As String
    Dim firstRow As Integer
    Dim lastRow As Integer
   
    firstRow = 0
    Application.ScreenUpdating = False
    Sheets("Report").Protect Contents:=False
   
    strCategory = Sheets("Report").ComboBox1.Text
    Sheets("Report").Rows(4 & ":" & Sheets("Report").UsedRange.Rows.count).Hidden = True
   
    If strCategory = "ALL" Then
        Sheets("Report").Rows(4 & ":" & Sheets("Report").UsedRange.Rows.count).Hidden = False
    End If
   
    For i = 4 To Sheets("Report").UsedRange.Rows.count
        If Sheets("Report").Range("A" & i).Value = strCategory Then
            firstRow = i
        End If
       
        If Sheets("Report").Range("A" & i).Value = strCategory & " Total" Then
            lastRow = i
        End If
    Next i
   
    If firstRow <> 0 And lastRow <> 0 Then
        Sheets("Report").Rows(firstRow & ":" & lastRow).Hidden = False
    End If
   
    Sheets("Report").Protect Contents:=True
End Sub

3 示例三：保护报表中的数据

1）在模块（Module1）中，设计一个名为protectCells的过程，设保护区域（locked ture），也可设未保护、可编辑区域(locked false)，并将保护选项设为True。
Sub protectCells()
    'Author       : http://blog.sina.com.cn/lightonlife
    'Macro purpose: set protected/unprotected cells
    Dim i As Integer
       
    Application.ScreenUpdating = False
    Application.StatusBar = ""
   
 
    i = Sheets("Report").UsedRange.Rows.count
   
    Sheets("Report").Rows(4 & ":" & i).Locked = True
    Sheets("Report").Range("A1").Locked = False
    Sheets("Report").Protect Contents:=True

End Sub 

2) 更新thisWorkbook workbook open事件，加入保护代码。先要解保护，组合功能才有效，执行完保护过程后，需要利用代码（高亮语句）解除组合展开/折叠的保护。

Private Sub Workbook_Open()
    'Author       : http://blog.sina.com.cn/lightonlife
    'Macro purpose: initiate worksheet
   
    Sheets("Report").Protect Contents:=False
   
    Call RemoveDatarowsGroup
    Call DatarowsGroup
    Call protectCells
    Sheets("Report").Protect Password:="", userinterfaceonly:=True
    Sheets("Report").EnableOutlining = True

End Sub