[發問] VBA 搜尋資料列對應的最大值或最小值

junkwei

各位前輩大家好:
小弟剛開始自學EXCEL VBA 程式一段時間
每次從網路上搜尋問題解答都會搜尋到這個論壇
知道這個論壇的前輩都身懷絕技....
剛好最近有個問題
從網路上及自己買的書上都搜尋不到好的解法
因此就註冊會員來向各位前輩請教
希望往後也能在這個版上和大家一起學習^^

下載 (52.63 KB)

2014-11-27 22:31

問題如下:
如照片中的例子, 左表為從ACEESS匯入的資料
小弟希望能將資料整理整理成左表的形式
就是將"班級"那欄所對應到所有的"年紀"作最大值及最小值的的搜尋
也就是像ACEESS 中『查詢精靈』的功能

以下兩種方式是小弟想到的, 都可以解決我的問題:
1. 從ACCESS匯入資料時就直接將原始資料用『查詢精靈』先做整理後再匯入EXCEL工作表  (不知道VBA有沒有這種功能可以呼叫查詢精靈 ?)

2. 將原始資料如照片先匯入EXCEL工作表後再做整理


再麻煩各位前輩指教了!  感激不盡~~!

owen06

回復 1# junkwei


    找尋符合條件的最大值：
    在F2輸入=MAX(($A$2:$A$16=E2)*$C$2:$C$16)，此為陣列公式，輸入完成後要按CTRL+SHIFT+ENTER，
    再把公式往下拉即可。
   
    找尋符合條件的最小值：
    在G2輸入=MIN(IF($A$2:$A$16=E2,$C$2:$C$16,FALSE))，此為陣列公式，輸入完成後要按CTRL+SHIFT+ENTER，
    再把公式往下拉即可。

joey0415

回復 1# junkwei

sql語法即可完成
stock.mdb=>換成你的資料庫名稱
某某表=>換成你資料庫中的資料表名稱

以上是mdb語法，新資料庫請自行搜尋替換

1. Sub ex()
   
2. 
   
3.     Worksheets("1").Activate
   
4.     Set cn = CreateObject("adodb.connection")
   
5.     cn.Open ("Driver={Microsoft Access Driver (*.mdb)};dbq=" & ThisWorkbook.Path & "\stock.mdb")
   
6.     Set rs = cn.Execute("select 班級,max(年紀) as 最大年紀,min(年級) as 最小年紀 from   某某表  group by 班級")
   
7.     w = 1
   
8.     For Each tt In rs.Fields '顯示表單名稱
   
9.         Cells(w) = tt.Name
   
10.         w = w + 1
    
11.     Next
    
12.     Cells(2, 1).CopyFromRecordset (rs)'叫出資料
    
13.     cn.Close
    
14.     Set cn = Nothing
    
15.     Set rs = Nothing
    
16. 
    
17. End Sub

複製代碼

stillfish00

回復 1# junkwei
Excel 從選單的 資料>取得外部資料(從Access)>選檔案>匯入資料視窗: 檢視方式勾選樞紐分析表，然後拉一下欄位就可以了。

junkwei

謝謝 owen06  及 stillfish00前輩的指導，不過小弟所希望的方式是可以由VBA程式自動匯入的, 但還是謝謝你們撥空指導, 讓我學到EXCEL不同的分析方法 ~ ^^

junkwei

回復 3# joey0415

謝謝前輩的指導~
由於小弟VBA資歷尚淺
是否可以請前輩撥空稍加說明用法及語法呢
以便小弟方便應用及查詢相關的資訊呢??

其中有幾行小弟不太了解的地方如下:
1.
Set rs = cn.Execute("select 班級,max(年紀) as 最大年紀,min(年級) as 最小年紀 from   某某表  group by 班級")   
其中的『 最大年紀』及『最小年紀』是要自己先輸入的嗎?
P.S.小弟的需求是希望G2:I4的儲存格都是VBA自動分析產生的

2.
For Each tt In rs.Fields '顯示表單名稱
請問tt所代表的是工作表的名稱嗎?

不好意思~~~
再麻煩前輩撥空指導了
感激不盡~~!!

GBKEE

回復 5# junkwei

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, i As Integer, Ar()
   
4.     Set Rng = Range("iv1")
   
5.     '進階篩選出"班級"欄不重複的值
   
6.     Range("a:a").AdvancedFilter xlFilterCopy, , Rng, True
   
7.     ReDim Ar(1 To 3, 1 To 1) '陣列重置
   
8.     Ar(1, 1) = "班級"
   
9.     Ar(2, 1) = "最大年紀"
   
10.     Ar(3, 1) = "最小年紀"
    
11.     i = 2
    
12.     Do While Rng.Cells(i) <> "" '"班級"欄不重複的值(各班級)
    
13.        With Range("a:a")
    
14.             .Replace Rng.Cells(i), "=EX", xlWhole   '各班級換置為錯誤值
    
15.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
    
16.                 ReDim Preserve Ar(1 To 3, 1 To i)
    
17.                 Ar(1, i) = Rng.Cells(i)
    
18.                 Ar(2, i) = Application.Max(.Cells.Offset(, 2))
    
19.                 Ar(3, i) = Application.Min(.Cells.Offset(, 2))
    
20.                 .Value = Rng.Cells(i)              '錯誤值換置回為各班級
    
21.             End With
    
22.             i = i + 1
    
23.        End With
    
24.     Loop
    
25.     Rng.EntireColumn.Clear              '清除:進階篩選出"班級"欄不重複的值
    
26.     Range("g1").Resize(UBound(Ar, 2), UBound(Ar, 1)) = Application.WorksheetFunction.Transpose(Ar)
    
27.     'UBound(Ar, 2)陣列第2維的元素上限值
    
28.     'UBound(Ar, 1)陣列第1維的元素上限值
    
29. End Sub

複製代碼

junkwei

回復  junkwei
GBKEE 發表於 2014-12-4 07:01

真的很感謝GBKEE前輩的指導!!
這個code正是我要的功能!
vba果然功能強大...也看到好多沒看過的語法...0rz
但小弟研究前輩的code還是有些地方無法了解...上網查詢似乎也還是不太懂...
希望前輩可以不吝指導..
1. Set Rng = Range("iv1")           
請問這樣定義的range是怎麼樣的range呢?? iv1 不是表示舊版excel的第一欄的最後一格嗎?

2.  Range("a:a").AdvancedFilter xlFilterCopy, , Rng, True     
請問a:a是怎麼樣的範圍呢??這行code的邏輯我想半天還是想不通...

3.請問為什麼code中要把Ar()矩陣先以轉置後的位置輸入篩選，再以轉置後的位置輸出呢???

不好意思如果有敘述不好的地方請多見諒
再麻煩前輩指導了~謝謝~!!

GBKEE

回復 8# junkwei

Range("a:a").AdvancedFilter xlFilterCopy, , Rng, True
"a:a" -> A欄整欄
AdvancedFilter 方法 expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
CriteriaRange 沒有指定範圍,為不設下篩選條件,
Ar([相對為工作表的欄數], [相對為工作表的列數]) ,與工作表的Cells(列,欄)顛倒
ReDim Preserve Ar(1 To 3, 1 To i)
選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。

junkwei

回復  junkwei

Range("a:a").AdvancedFilter xlFilterCopy, , Rng, True
"a:a" -> A欄整欄
AdvancedF ...
GBKEE 發表於 2014-12-12 07:13

原來如此~~真的謝謝GBKEE版主的指導!!

關於您的code小弟尚有幾個問題想向您再確認一下:
1. 請問一開始的 Set Rng = Range("iv1") 是不是隨便指定一個range就可以了呢??
因為不是後面就被AdvancedFilter的結果取代掉了??   
   
2.
            .Replace Rng.Cells(i), "=EX", xlWhole   '各班級換置為錯誤值
            With .SpecialCells(xlCellTypeFormulas, xlErrors)
                .Value = Rng.Cells(i)              '錯誤值換置回為各班級
            End With
     這幾行的目的似乎是將各班級的年紀值挑出來後, 再對其取MAX跟MIN
     有爬到版主之前的文章對SpecialCells也都有類似的用法..
     但看了半天跟上網搜尋還是無法完全掌握正確的用法...
     想請問的第二個參數的 xlErrors是如何判定為錯誤的呢?  為什麼取代為"=EX"  就是錯誤值呢?
     xlCellTypeFormulas不是表示"使用公式的儲存格"嗎??


以上兩個問題再麻煩您撥空解惑了!!  謝謝~~~!