分組前三名語法 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 分組前三名語法

返回列表下一主題上一主題發帖

分組前三名語法

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

1^# 跳轉到 »

發表於 2014-1-16 11:31 | 顯示全部帖子

回復 1# joey0415

試試看

Option Explicit
Sub Ex()
Dim AR(), E As Variant, Rng As Range
With Sheets("Sheet1")
.Range("A1").CurrentRegion.Sort Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range( _
"A2"), Order2:=xlAscending, Key3:=.Range("D2"), Order3:=xlDescending, Header:=xlYes
'.Range("A1").CurrentRegion.Sort"資料的排序
.UsedRange.Columns(2).AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
'UsedRange.Columns(2)的進階篩選-> 不重複的股票
'**三十萬筆資料這兩行會慢一點
AR = Application.Transpose(.Cells(1, .Columns.Count).CurrentRegion.Offset(1))
'取得股票置入一維陣列中
ReDim Preserve AR(1 To UBound(AR) - 1) '刪除最後一筆的(空白)資料
.Cells(1, .Columns.Count).CurrentRegion.Clear '清除
.Range("F1").CurrentRegion.Offset(1).Clear '清除顯示前三筆資料的區域
For Each E In AR
Set Rng = .Range("B:B").Find(E, LookAT:=xlWhole) '找每一股票的第一個位置
.Range(.Cells(Rng.Row, "A"), .Cells(Rng.Row + 2, "D")).Copy .Cells(.Rows.Count, "F").End(xlUp).Offset(1)
Next
End With
End Sub

複製代碼

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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

2^#

發表於 2014-1-16 16:55 | 顯示全部帖子

本帖最後由 GBKEE 於 2014-1-16 17:26 編輯

回復 8# joey0415

Set Rng = .Range("B:B").Find(E, LookAT:=xlWhole) '找每一股票的第一個位置

複製代碼

已限制在Range("B:B")中,第一次搜尋當然會從第一個(1101)找起
LookAT:=xlWhole :與儲存格的內容完全相同是 1101 不是 A1101B

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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

3^#

發表於 2014-1-16 21:23 | 顯示全部帖子

回復 10# joey0415

版大的文章也常用 .End(xlUp).Offset(1)之類的定位找某一格或關鍵的上一個或下一格，不知道哪有相關的說明會清楚一些

Option Explicit
Sub Ex()
Dim 物件 As Worksheet
Set 物件 = Sheets("Sheet1") '將Sheets("Sheet1")指定到物件變數
With 物件.Range("a1:f1")
.Font.Size = 15
'會出現 .屬性,方法
End With
With Sheet1.Range("a1:f1") 'Sheet1 是專案中的物件(工作表物件的CodeName)
'With Sheets("Sheet1").Range("a1:f1") '不會出現 .屬性,方法
.Font.Size = 15
'會出現 .屬性,方法
End With
End Sub

複製代碼

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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

4^#

發表於 2014-1-17 15:52 | 顯示全部帖子

回復 12# joey0415

vba-名單比對相符合回寫資料參考參考

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

靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。

返回列表下一主題上一主題