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

ji12345678

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

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

下載 (87.11 KB)

2013-6-16 17:17

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

下載次數: 32

2013-6-16 17:18

GBKEE

回復 1# ji12345678
使用 Sort 方法 [排序]

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim E As Range, Sh As Worksheet
   
4.     Set Sh = Sheets("Sheet1")                                           '設定變數 : 資料所在的工作表
   
5.     Application.ScreenUpdating = False                                  '停止 : 銀幕的更新
   
6.     With Sheets.Add                                                     '新增一工作表
   
7.         Sh.[A:B].Copy                                                   '資料複製
   
8.         .[A1].PasteSpecial Paste:=xlPasteValues                         '選擇性貼上 : 僅貼上值
   
9.         .[C1] = "位置"
   
10.         For Each E In .Range(.[C2], .[B2].End(xlDown).Offset(, 1))      'C欗的範圍
    
11.             E = E.Offset(, -1).Address(0, 0)                            '寫上B欄的位置
    
12.         Next
    
13.         With .Range("A1").CurrentRegion                                 '[A1].的延伸範圍
    
14.             .Sort Key1:=.Range("B2"), Order1:=xlDescending, Header:=xlYes  '排序 : xlDescending (遞減: 由大到小), xlAscending  (遞增: 由小到大)
    
15.            '.Sort Key1:=.Range("B2"), Order1:=xlDescending, Key2:=.Range("A2"), Order2:= xlDescending , Header:=xlYes
    
16.                                                                             '第1排序 : 數量, 第2排序: 品名
    
17.             .Rows(1).Resize(6).Copy Sh.[G2]                             '複製:[A1].的延伸範圍:的6列擴充 到 資料所在工作表的[G2]
    
18.         End With
    
19.         Application.DisplayAlerts = False                               '停止:系統的提醒
    
20.         .Delete                                                         '刪除:新增的工作表
    
21.         Application.DisplayAlerts = True                                '恢復:系統的提醒
    
22.     End With
    
23.     Application.ScreenUpdating = True                                   '恢復:銀幕的更新
    
24. End Sub

複製代碼

c_c_lai

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

wanney1111111

回復 2# GBKEE


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

GBKEE

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

下載 (154.72 KB)

2013-9-23 06:38

joey0415

回復 1# ji12345678

SQL法

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

區域大小可改   Sheet1$A1:B50

前幾名可改    top 5

   

下載 (206.56 KB)

2013-11-7 11:50