【軟件】3個(gè)Excel VBA示例（自動(dòng)組合\篩選\保護(hù)）

(2010-12-21 14:17:46)

   在前一篇SSRS report builder的示例中，通過(guò)一些小設(shè)置就能輕松實(shí)現(xiàn)Web報(bào)表組合字段的展開(kāi)與折疊，這里，受這個(gè)特性啟發(fā)，運(yùn)用VBA代碼，在Excel中設(shè)計(jì)一個(gè)類(lèi)似功能的示例，實(shí)現(xiàn)：

1）自動(dòng)組合地區(qū)、產(chǎn)品，默認(rèn)按小計(jì)折疊顯示（圖一），優(yōu)點(diǎn)是節(jié)省手工設(shè)組合行的時(shí)間，并支持動(dòng)態(tài)數(shù)據(jù)。 

2）按地區(qū)條件實(shí)現(xiàn)篩選（圖二），之前有幾個(gè)用公式實(shí)現(xiàn)篩選的示例，實(shí)現(xiàn)上有些復(fù)雜，VBA可簡(jiǎn)化許多。

3）報(bào)表區(qū)域?qū)崿F(xiàn)保護(hù)，即只讀，不可編輯。Excel設(shè)了保護(hù)后，組合展開(kāi)/折疊（+/-）也被保護(hù)了，需使用一個(gè)技巧，保護(hù)報(bào)表數(shù)據(jù)的同時(shí)解除組合展開(kāi)/折疊的保護(hù)。

環(huán)境：Excel 2010

預(yù)備知識(shí)：Excel組合功能（group/ungroup/outline等）

1 示例一： 自動(dòng)組合地區(qū)、產(chǎn)品，默認(rèn)顯示各地區(qū)產(chǎn)品銷(xiāo)售小計(jì)

圖一：

1）設(shè)計(jì)一個(gè)數(shù)據(jù)表，包含地區(qū)銷(xiāo)售小計(jì)，產(chǎn)品銷(xiāo)售小計(jì)及各產(chǎn)品子類(lèi)的銷(xiāo)售額，例如圖二所示。

2）在模塊（Module1）中，設(shè)計(jì)一個(gè)名為DatarowsGroup的過(guò)程，兩個(gè)循環(huán)段分別實(shí)現(xiàn)按地區(qū)組合行，再按產(chǎn)品組合行，并以小計(jì)級(jí)別（級(jí)別2）默認(rèn)顯示。

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）中，設(shè)計(jì)一個(gè)名為RemoveDatarowsGroup的過(guò)程，清除所有的組合，關(guān)鍵代碼：

    Sheets("Report").Range("A2").ClearOutline
4）在thisWorkbook workbook open事件中，調(diào)用這兩個(gè)模塊過(guò)程，實(shí)現(xiàn)每次打開(kāi)Excel文件，自動(dòng)顯示地區(qū)、產(chǎn)品銷(xiāo)售小計(jì)。

Private Sub Workbook_Open()  
    Call RemoveDatarowsGroup
    Call DatarowsGroup
 End Sub

2 示例二：使用VBA代碼按地區(qū)條件篩選銷(xiāo)售信息

圖二：

1）設(shè)計(jì)一個(gè)地區(qū)（Region）下拉菜單，作為篩選條件，如何實(shí)現(xiàn)，請(qǐng)參閱相關(guān)博文。

2）在這個(gè)下拉菜單的change事件中，編寫(xiě)下列代碼，顯示符合條件/隱藏不符合條件的行記錄是VBA實(shí)現(xiàn)篩選的基本思路。這段代碼大意是：先隱藏報(bào)表數(shù)據(jù)區(qū)所有行記錄，如果選全部，則顯示所有隱藏的行記錄，如果選某個(gè)地區(qū)條件，則顯示該地區(qū)第一條至最后一條的記錄（由條件語(yǔ)句控制）。

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 示例三：保護(hù)報(bào)表中的數(shù)據(jù)

1）在模塊（Module1）中，設(shè)計(jì)一個(gè)名為protectCells的過(guò)程，設(shè)保護(hù)區(qū)域（locked ture），也可設(shè)未保護(hù)、可編輯區(qū)域(locked false)，并將保護(hù)選項(xiàng)設(shè)為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事件，加入保護(hù)代碼。先要解保護(hù)，組合功能才有效，執(zhí)行完保護(hù)過(guò)程后，需要利用代碼（高亮語(yǔ)句）解除組合展開(kāi)/折疊的保護(hù)。

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