帖子: 28
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: SP2
閱讀權限: 20
性別: 女
註冊時間: 2012-5-4
最後登錄: 2016-9-29

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-6-16 17:18 | 只看該作者

[發問] 請教如何用VBA找出最大值、第二大值…… 萬分感謝…

(1)請教如何用VBA寫出一個程式，功能為
列出數量最多、數量第2多…到數量第5多 (前5多) 排列出來。
且填入相對的位置。
(2)而當數量相同時，可以先列出先出現的品名，亦可依品名排序；
先出現的先列出來。

謝謝指教，萬分感謝…........... 。:'(

102.6.16-請教問題.rar (2.48 KB)

樓主熱帖

joey0415

　暱稱: joey0415

中學生 Rank: 2

帖子: 361
主題: 57
精華: 0
積分: 426
點名: 0
作業系統: win7
軟體版本: 2003,2010
閱讀權限: 20
性別: 男
註冊時間: 2010-5-13
最後登錄: 2022-12-8

6^#

發表於 2013-11-7 11:51 | 只看該作者

回復 1# ji12345678

SQL法

select top 5 * from [Sheet1$A1:B50] order by 數量 desc

區域大小可改 Sheet1$A1:B50

前幾名可改 top 5

TOP

GBKEE

超級版主 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兔年全勤獎章

5^#

發表於 2013-9-23 06:39 | 只看該作者

回復 4# wanney1111111
sort有橫的排序,試用錄製巨集可得程式碼.

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

TOP

wanney1111111

小學生 Rank: 1

帖子: 1
主題: 0
精華: 0
積分: 1
點名: 0
作業系統: WINDOWS 7
軟體版本: SP1
閱讀權限: 10
註冊時間: 2013-9-23
最後登錄: 2013-9-23

4^#

發表於 2013-9-23 00:33 | 只看該作者

本帖最後由 wanney1111111 於 2013-9-23 00:35 編輯

回復 2# GBKEE

請問一下，那如果我跟版主的問題類似，但是我是要做橫列的排序，搞了很久還是搞不出來，麻煩大師您了..

ASDASDAS.jpg (17.48 KB)

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

3^#

發表於 2013-6-20 07:57 | 只看該作者

回復 2# GBKEE
此處 Sheets.Add 的佈局用得實在非常巧妙，
既可達到目的，又可提供做為額外的暫存作業區，
多謝 GBKEE 版大的賜教。

TOP

GBKEE

超級版主 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^#

發表於 2013-6-19 18:31 | 只看該作者

回復 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

複製代碼

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

TOP