[發問] 如何計算每個欄的累計最大失分

cdkee

請教大大以下如何利用VBA做到，謝謝!
7列=D欄中累計最大失分(黃色部份)
8列=D欄中累計第2大失分(綠色部份)
9列=D欄中累計第3大失分(橙色部份)
test3.rar (3.53 KB)

下載次數: 18

2016-8-14 09:32

VBALearner

回復 1# cdkee

首先由上而下把創新高的儲存格挑出來記錄好數值，再把兩兩創新高儲存格中間範圍的最小值儲存格挑出來計算最大失分，最後再排序出最小值、第二小、第三小的數字顯示出來即可

cdkee

回復 2# VBALearner

始終弄不清，可否請各位大大示範，謝謝!

VBALearner

該程式碼設定您的15個數據在A1到A15，看懂程式碼後可自行更改Cells(?,?)
也希望有高手能來參與討論簡化或提出更厲害的方法OwO

1. Option Base 1
   
2. Sub test()
   
3.     Dim NewHigh, NewLow, i, j, k As Integer: NewHigh = 0: NewLow = 0: j = 1: k = 1
   
4.     Dim NewLowRecord(15), FinalRecord()
   
5.    
   
6.     For i = 2 To 15
   
7.         If Cells(i, 1).Value >= NewHigh Then '紀錄創新高壞持平
   
8.             NewHigh = Cells(i, 1).Value
   
9.             If Not IsEmpty(NewLowRecord(1)) Then '判斷非連續創高
   
10.                 ReDim Preserve FinalRecord(j)
    
11.                 FinalRecord(j) = Application.Small(NewLowRecord, 1) '紀錄創高區間內所有拉回的最小值
    
12.                 Erase NewLowRecord '清空拉回值暫存
    
13.                 j = j + 1
    
14.                 k = 1
    
15.             End If
    
16.         Else
    
17.             NewLow = Cells(i, 1).Value - NewHigh
    
18.             NewLowRecord(k) = NewLow '紀錄拉回值(與上一新高之差)
    
19.             k = k + 1
    
20.         End If
    
21.     Next
    
22.    
    
23.     MsgBox "最大拉回 : " & Application.Small(FinalRecord, 1)
    
24.     MsgBox "第二大拉回 : " & Application.Small(FinalRecord, 2)
    
25.     MsgBox "第三大拉回 : " & Application.Small(FinalRecord, 3)
    
26. End Sub

複製代碼

最大失分(拉回).zip (11.63 KB)

下載次數: 7

2016-8-14 20:38

回復 3# cdkee

GBKEE

回復 4# VBALearner
換湯不換藥,來湊一腳

1. 'Option Base 1  '所修改的程式可不必 Option Base 1
   
2. Sub Ex()
   
3.     Dim NewHigh As Long, NewLow As Long, LowRecord As Long, i As Integer, j As Integer
   
4.     Dim FinalRecord()
   
5.     ' NewHigh = 0: NewLow = 0 ' **變數型態為數字,程式一開始皆為0值
   
6.     For i = 2 To 15
   
7.         If Cells(i, 1).Value >= NewHigh Then '紀錄創新高壞持平
   
8.             NewHigh = Cells(i, 1).Value
   
9.             If LowRecord <> 0 Then  '判斷非連續創高
   
10.                 ReDim Preserve FinalRecord(0 To j)
    
11.                 FinalRecord(j) = LowRecord
    
12.                 LowRecord = 0             '清空拉回值暫存
    
13.                j = j + 1
    
14.             End If
    
15.         Else
    
16.             NewLow = Cells(i, 1).Value - NewHigh
    
17.             LowRecord = IIf(LowRecord >= NewLow, NewLow, LowRecord)
    
18.         End If
    
19.     Next
    
20.     MsgBox "最大拉回 : " & Application.Small(FinalRecord, 1)
    
21.     MsgBox "第二大拉回 : " & Application.Small(FinalRecord, 2)
    
22.     MsgBox "第三大拉回 : " & Application.Small(FinalRecord, 3)
    
23. End Sub

複製代碼

cdkee

回復 4# VBALearner
回復 5# GBKEE
謝謝兩位大大指導!
因為會不斷有多組累計分數加入，再請教如何將結果放在7,8,9列，謝謝!
test5.rar (9.15 KB)

下載次數: 4

2016-8-15 09:47

VBALearner

回復 6# cdkee

放在7,8,9列

1.     Cells(7,??) = Application.Small(FinalRecord, 1)
   
2.     Cells(8,??) = Application.Small(FinalRecord, 2)
   
3.     Cells(9,??) = Application.Small(FinalRecord, 3)

複製代碼

不斷往下統計新增的資料

1. Do while Cells(i,??).value <> ""
   
2. ...
   
3. i=i+1
   
4. loop

複製代碼

cdkee

回復 7# VBALearner

謝謝大大再次教導!
例子是向右增加"累計分數"組，每組都在7,8,9列顯示結果，應如何改寫，謝謝!

VBALearner

回復 8# cdkee

i是資料最左邊的起始欄位編號，D欄就是4
資料位置跟...的部分就依照你的需要自行改寫吧~

1. i = 4
   
2. do while cells(20,i) <> ""
   
3.    
   
4.     ...'計算失分程式
   
5. 
   
6.     cells(7,i) = application.worksheetfunction.Small(FinalRecord,1)
   
7.     cells(8,i) = application.worksheetfunction.Small(FinalRecord,2)
   
8.     cells(9,i) = application.worksheetfunction.Small(FinalRecord,3)
   
9.     i = i + 1
   
10. loop  

複製代碼

cdkee

只有第1組計算正確，其他組都計算不正確，請大大幫忙應該如何改，謝謝!
test5V.rar (14.69 KB)

下載次數: 2

2016-8-15 17:36