- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 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
|
|
發表於 2014-1-16 12:26
| 
