想請教有關計算重複名字排序的語法 - Excel程式區

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2014-10-22 09:16 | 顯示全部帖子

回復 1# united7878
試試看

Option Explicit
Sub Ex_進階篩選()
Dim Rng(1 To 3) As Range
'****************************************************************
Set Rng(1) = [c3:c1002] '資料庫範圍: c3要是為資料庫的欄位標頭
'****************************************************************
Set Rng(2) = [IU1] '工作表最後第2欄:進階篩選,資料複製到的儲存格
Set Rng(3) = [M4:N13] '放置重覆最多的前10名的儲存格
Rng(2).CurrentRegion = "" 'Rng(2)必需是沒有資料
Rng(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Rng(2), Unique:=True
'進階篩選不重複的資料(Unique:=True)
With Range(Rng(2), Rng(2).End(xlDown)).Offset(1)
.Offset(, 1).FormulaR1C1 = "=COUNTIF(" & Rng(1).Address(, , xlR1C1) & ",RC[-1])" '
'寫上工作表函數COUNTIF
Rng(2).CurrentRegion.Sort KEY1:=Rng(2).Range("b1"), Order1:=xlDescending, Header:=xlYes
'Rng(2).CurrentRegion(連續範圍)的由大到小的排序(Order1:=xlDescending)
Rng(3) = Rng(2).Range("A2").Resize(10, 2).Value '資料複製
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2014-10-22 20:45 | 顯示全部帖子

回復 3# united7878
[Ex_進階篩選] 可以是一般模組,或是這工作表模組上的程序(巨集)

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2014-10-24 06:33 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-10-24 06:55 編輯

回復 5# united7878
是必須解除C欄與IU欄或L欄M欄之資料與儲存部分欄位的鎖定.
保護工作表有許多選項,可參考VBA說明, Protect 方法.
請選擇排序,使用自動篩選

複製代碼

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

[發問] 想請教有關計算重複名字排序的語法