- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# ji12345678
使用 Sort 方法 [排序]- Option Explicit
- Sub Ex()
- Dim E As Range, Sh As Worksheet
- Set Sh = Sheets("Sheet1") '設定變數 : 資料所在的工作表
- Application.ScreenUpdating = False '停止 : 銀幕的更新
- With Sheets.Add '新增一工作表
- Sh.[A:B].Copy '資料複製
- .[A1].PasteSpecial Paste:=xlPasteValues '選擇性貼上 : 僅貼上值
- .[C1] = "位置"
- For Each E In .Range(.[C2], .[B2].End(xlDown).Offset(, 1)) 'C欗的範圍
- E = E.Offset(, -1).Address(0, 0) '寫上B欄的位置
- Next
- With .Range("A1").CurrentRegion '[A1].的延伸範圍
- .Sort Key1:=.Range("B2"), Order1:=xlDescending, Header:=xlYes '排序 : xlDescending (遞減: 由大到小), xlAscending (遞增: 由小到大)
- '.Sort Key1:=.Range("B2"), Order1:=xlDescending, Key2:=.Range("A2"), Order2:= xlDescending , Header:=xlYes
- '第1排序 : 數量, 第2排序: 品名
- .Rows(1).Resize(6).Copy Sh.[G2] '複製:[A1].的延伸範圍:的6列擴充 到 資料所在工作表的[G2]
- End With
- Application.DisplayAlerts = False '停止:系統的提醒
- .Delete '刪除:新增的工作表
- Application.DisplayAlerts = True '恢復:系統的提醒
- End With
- Application.ScreenUpdating = True '恢復:銀幕的更新
- End Sub
|
|
發表於 2013-6-19 18:31
| 
