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

複製代碼