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

hanzinu 2011-05-02

展開全文

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

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

標(biāo)簽：

保護(hù)

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

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

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

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

環(huán)境：Excel 2010

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

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

圖一：

$【軟件】3個Excel <wbr>VBA示例（自動組合\篩選\保護(hù)）$

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

2）在模塊（Module1）中，設(shè)計一個名為DatarowsGroup的過程，兩個循環(huán)段分別實現(xiàn)按地區(qū)組合行，再按產(chǎn)品組合行，并以小計級別（級別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è)計一個名為RemoveDatarowsGroup的過程，清除所有的組合，關(guān)鍵代碼：

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

Private Sub Workbook_Open()
    Call RemoveDatarowsGroup
    Call DatarowsGroup
End Sub

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

圖二：

$【軟件】3個Excel <wbr>VBA示例（自動組合\篩選\保護(hù)）$

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

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

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ù)報表中的數(shù)據(jù)

1）在模塊（Module1）中，設(shè)計一個名為protectCells的過程，設(shè)保護(hù)區(qū)域（locked ture），也可設(shè)未保護(hù)、可編輯區(qū)域(locked false)，并將保護(hù)選項設(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ù)過程后，需要利用代碼（高亮語句）解除組合展開/折疊的保護(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