- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2014-10-24 06:33
| 只看該作者
本帖最後由 GBKEE 於 2014-10-24 06:55 編輯
回復 5# united7878
是必須解除C欄與IU欄或L欄M欄之資料與儲存部分欄位的鎖定.
保護工作表有許多選項,可參考VBA說明, Protect 方法.
請選擇 排序,使用自動篩選- Option Explicit
- Sub Ex()
- ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
- , AllowSorting:=True, AllowFiltering:=True
- End Sub
Ex_進階篩選 須修改一下- Sub Ex_進階篩選()
- Dim Rng(1 To 3) As Range
- '****************************************************************
- Set Rng(1) = [c3:c1002] '資料庫範圍: c3要是為資料庫的欄位標頭
- '****************************************************************
- Set Rng(2) = [IU:IV] '工作表最後第2欄:進階篩選,資料複製到 的儲存格
- Set Rng(3) = [M4:N13] '放置重覆最多的前10名 的儲存格
- Rng(2) = "" 'Rng(2)必需是沒有資料
-
- Rng(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Rng(2).Cells(1), Unique:=True
- '進階篩選不重複的資料(Unique:=True)
- With Rng(2)
- .Sort KEY1:=Rng(2).Range("a1"), Order1:=xlDescending, Header:=xlYes
- '範圍的由大到小的排序(Order1:=xlDescending)
- End With
- With Range(Rng(2).Cells(1), Rng(2).Cells(1).End(xlDown))
- .Offset(1, 1).FormulaR1C1 = "=COUNTIF(" & Rng(1).Address(, , xlR1C1) & ",RC[-1])" '
- '寫上工作表函數COUNTIF
- End With
- With Rng(2)
- .Sort KEY1:=Rng(2).Range("b1"), Order1:=xlDescending, Header:=xlYes
- End With
- Rng(3) = Rng(2).Range("A2").Resize(10, 2).Value '資料複製
- End Sub
|
|
發表於 2014-10-21 23:55
| 
