123
返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
21# 跳轉到 »
發表於 2016-8-16 17:21 | 只看該作者
回復 20# cdkee
插入一般模組，貼上下面code
  1. Function FindMaxLoss(rngInput As Range, Optional order As Integer = 1)
  2.     On Error GoTo ErrHandle
  3.    
  4.     Dim ar, arLoss
  5.     ar = Application.Transpose(rngInput)
  6.     ReDim arLoss(1 To UBound(ar))
  7.    
  8.     Dim i, count As Integer, sum As Double
  9.     Dim indMin As Long, indMax As Long
  10.     indMin = 1: indMax = 1
  11.     i = 2
  12.     Do While i <= UBound(ar)
  13.         If ar(i) < ar(indMin) Then indMin = i
  14.         If ar(i) > ar(indMax) Or i = UBound(ar) Then
  15.             If indMin <> indMax Then
  16.                 count = count + 1
  17.                 arLoss(count) = ar(indMin) - ar(indMax)
  18.                 i = indMin
  19.             End If
  20.             indMin = i
  21.             indMax = i
  22.         End If
  23.         i = i + 1
  24.         DoEvents
  25.     Loop
  26.         
  27.     ReDim Preserve arLoss(1 To count)
  28.     FindMaxLoss = Application.WorksheetFunction.Small(arLoss, order)
  29.     Exit Function
  30.    
  31. ErrHandle:
  32.     FindMaxLoss = CVErr(xlErrValue)
  33. End Function
複製代碼
D7填上公式  =FindMaxLoss(D$20:D$34,1)
D8填上公式  =FindMaxLoss(D$20:D$34,2)
D9填上公式  =FindMaxLoss(D$20:D$34,3)
向右拖曳填滿公式
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

cdkee

帖子
185 
主題
47 
精華
0 
積分
227 
點名
0  
作業系統
WIN 7 
軟體版本
旗舰版 
閱讀權限
20 
性別
男 
註冊時間
2010-9-14 
最後登錄
2024-11-19 
20#
發表於 2016-8-16 14:29 | 只看該作者
回復  cdkee
看不懂你的邏輯
第一組2016/5/5開始 1000,900,700,800,600,300
700到800有得分啊，結果你用 ...
stillfish00 發表於 2016-8-16 14:16

因為是要累計最大失分，不是要連續最大失分。

TOP

cdkee

帖子
185 
主題
47 
精華
0 
積分
227 
點名
0  
作業系統
WIN 7 
軟體版本
旗舰版 
閱讀權限
20 
性別
男 
註冊時間
2010-9-14 
最後登錄
2024-11-19 
19#
發表於 2016-8-16 14:24 | 只看該作者
回復 16# VBALearner

計算列20至列813都無問題
計算列20至列814出"溢位錯誤"
請教各大大我的修改那裡錯，謝謝!
TEST7V.rar (26.62 KB)

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
18#
發表於 2016-8-16 14:16 | 只看該作者
回復 15# cdkee
看不懂你的邏輯
第一組2016/5/5開始 1000,900,700,800,600,300
700到800有得分啊，結果你用1000-300=700失分
而不是分為 1000-700 , 800-300 這兩組失分
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

cdkee

帖子
185 
主題
47 
精華
0 
積分
227 
點名
0  
作業系統
WIN 7 
軟體版本
旗舰版 
閱讀權限
20 
性別
男 
註冊時間
2010-9-14 
最後登錄
2024-11-19 
17#
發表於 2016-8-16 13:09 | 只看該作者
回復 16# VBALearner
謝謝大大不厭小弟煩而幫助，大大的最終版小弟仍在了解中。
想表示回覆哪位大大，只要在那位大大留言按"回覆"，之後COPY個URL，再複製到自己的回覆內容就可以。
再謝謝VBALearner大大!

TOP

VBALearner

帖子
102 
主題
14 
精華
0 
積分
142 
點名
0  
作業系統
Win10 
軟體版本
Office2016 
閱讀權限
20 
性別
男 
註冊時間
2016-7-31 
最後登錄
2020-3-21 

論壇贊助勳章
16#
發表於 2016-8-16 11:44 | 只看該作者
本帖最後由 VBALearner 於 2016-8-16 11:59 編輯

回復 15# cdkee

您還真是不厭其煩的想達成這個目標呢-w-
再幫您努力一下吧，有始有終。對了可以問你要怎麼同時回復兩個人嗎xD? 我看到你有一篇回復的回復標籤有我和超級版主，如何做到?
這是最終版了，可以計算3大失分，一樣文末有附檔。程式邏輯有點難解釋，主要是根據顏色區塊的不重複性，來做有效值得篩選判斷，因此在計算第一大失分時，條件是最寬鬆的，因為此時還沒有出現顏色區塊(select case m = 1)。計算第二大失分時，要避免i,j值跨過或落在黃色區塊，因此i,j值只有兩種狀況: 1.<黃色區塊的上界 2.>黃色區塊的下界。根據這種邏輯繼續去做第三大失分的邏輯判斷，計算第3大失分時，已經有黃顏與綠色兩大區塊，因此會有兩個上界和兩個下界，此時應先判斷黃色或綠色區塊誰在上方(select case 3裡面的if 上界(3) > 下界(2)...)，再做失分計算判斷，此時資料有經被兩大顏色區塊切成3份，因此新的i,j值變成要落在這3份非顏色區塊裡面才是有效值，否則將與黃綠色區塊重複，大概的邏輯是如此，有些困難，但動手在紙上把圖畫出來，把上界和下界標上去應該會好懂些，此外，若無失分，會顯示失分為0。跟之前一樣，歡迎高手來改寫我這落落等的程式哈哈哈!!!
  1. Dim 欄, 失分, 紀錄上界, 紀錄下界, 上界(1 To 3), 下界(1 To 3), i, j, Z As Integer
  2. Sub 計算失分()
  3.     紀錄上界 = 0
  4.     紀錄下界 = 0

  6.     For 欄 = 1 To 7
  7.         For m = 1 To 3 '計算第m大失分
  8.             上界(m) = 紀錄上界
  9.             下界(m) = 紀錄下界
  10.             失分 = 0
  11.             For i = 1 To 14
  12.                 For j = i + 1 To 15
  13.                     Z = (Cells(i, 欄) - Cells(j, 欄))
  14.                     If Z > 失分 Then
  15.                         Select Case m
  16.                         Case 1 '第一大失分計算
  17.                             Call 紀錄
  18.                         Case 2 '第二大失分的限制條件
  19.                             If i < 上界(m) And j < 上界(m) Then
  20.                                 Call 紀錄
  21.                             ElseIf i > 下界(m) And j > 下界(m) Then
  22.                                 Call 紀錄
  23.                             End If
  24.                         Case 3 '第三大失分的限制條件
  25.                             If 上界(3) > 下界(2) Then
  26.                                 If i < 上界(2) And j < 上界(2) Then
  27.                                     Call 紀錄
  28.                                 ElseIf i > 下界(2) And j > 下界(2) And i < 上界(3) And j < 上界(3) Then
  29.                                     Call 紀錄
  30.                                 ElseIf i > 下界(3) And j > 下界(3) Then
  31.                                     Call 紀錄
  32.                                 End If
  33.                             ElseIf 上界(2) > 下界(3) Then
  34.                                 If i < 上界(3) And j < 上界(3) Then
  35.                                     Call 紀錄
  36.                                 ElseIf i > 下界(3) And j > 下界(3) And i < 上界(2) And j < 上界(2) Then
  37.                                     Call 紀錄
  38.                                 ElseIf i > 下界(2) And j > 下界(2) Then
  39.                                     Call 紀錄
  40.                                 End If
  41.                             End If
  42.                         End Select
  43.                     End If
  44.                 Next
  45.             Next
  46.             
  47.             Cells(6 + m, 欄 + 12) = -失分 '貼上工作表，位置自行更改
  48.         Next
  49.     Next
  50. End Sub

  52. Sub 紀錄()
  53.     失分 = Z
  54.     紀錄上界 = i
  55.     紀錄下界 = j
  56. End Sub
複製代碼
失分計算.zip (21.49 KB)
真心感謝每一位願意分享所學、指導新手的人!

TOP

cdkee

帖子
185 
主題
47 
精華
0 
積分
227 
點名
0  
作業系統
WIN 7 
軟體版本
旗舰版 
閱讀權限
20 
性別
男 
註冊時間
2010-9-14 
最後登錄
2024-11-19 
15#
發表於 2016-8-16 10:58 | 只看該作者
本帖最後由 cdkee 於 2016-8-16 11:00 編輯

回復 14# VBALearner

感謝大大幫忙!已經幫我節省了很多工作時間。
經過修改和測試後，有2組(第3組,第5組)計算錯誤，見附件，煩請教各位大大幫忙如何修改，謝謝!
test6V.rar (14.12 KB)

TOP

VBALearner

帖子
102 
主題
14 
精華
0 
積分
142 
點名
0  
作業系統
Win10 
軟體版本
Office2016 
閱讀權限
20 
性別
男 
註冊時間
2016-7-31 
最後登錄
2020-3-21 

論壇贊助勳章
14#
發表於 2016-8-16 00:48 | 只看該作者
回復 13# cdkee
不好意思，我決定先假設存在第一大失分與第二大失分的情況來寫程式，不做Debug，也暫時放棄嘗試計算第三大失分
麻煩版上各位高手也來集思廣益，我自認我想的這個程式似乎不是很聰明，還需各位激盪腦力!
麻煩問題提問者，看懂這個程式的邏輯後，再試試看如何寫出第三大失分，我就先努力到這了，準備休息睡覺TwT
本程式設定資料位在A1.resize(20,1)，針對此資料範圍做計算。重點在於計算大二大失分時，資料不能與第一大失分的資料範圍有所重複，否則將計算錯誤，因此予以紀錄第一大失分的上下界來做第二次計算的條件判讀。文末附有測試檔，歡迎下載改良!
  1. Sub 最大失分()
  2.     Dim 上界, 下界, 紀錄上界, 紀錄下界, i, j, k, m, n, x, 失分, z As Integer
  3.     上界 = 21
  4.     下界 = 0
  5.     失分 = 0
  6.         
  7.     For m = 1 To 2
  8.         For i = 1 To 19
  9.             For j = i + 1 To 20
  10.                 差值 = (Cells(i, 1) - Cells(j, 1))
  11.                 If 差值 > 0 And 差值 > 失分 Then
  12.                     If i < 上界 And j < 上界 Then
  13.                         失分 = 差值
  14.                         紀錄上界 = i
  15.                         紀錄下界 = j
  16.                     ElseIf i > 下界 And j > 下界 Then
  17.                         失分 = 差值
  18.                         紀錄上界 = i
  19.                         紀錄下界 = j
  20.                     End If
  21.                 End If
  22.             Next
  23.         Next
  24.         
  25.         上界 = 紀錄上界
  26.         下界 = 紀錄下界
  27.         
  28.         MsgBox "第" & m & "大失分 : " & 失分
  29.         失分 = 0
  30.     Next
  31. End Sub
複製代碼
測試.zip (11.61 KB)
真心感謝每一位願意分享所學、指導新手的人!

TOP

cdkee

帖子
185 
主題
47 
精華
0 
積分
227 
點名
0  
作業系統
WIN 7 
軟體版本
旗舰版 
閱讀權限
20 
性別
男 
註冊時間
2010-9-14 
最後登錄
2024-11-19 
13#
發表於 2016-8-15 23:32 | 只看該作者
回復 12# VBALearner

謝謝大大回覆!
(無失分)>>3個(列7,8,9)都顯示0
(無第二大失分)>>列8,9都顯示0
(無第三大失分)>>列9都顯示0

TOP

VBALearner

帖子
102 
主題
14 
精華
0 
積分
142 
點名
0  
作業系統
Win10 
軟體版本
Office2016 
閱讀權限
20 
性別
男 
註冊時間
2016-7-31 
最後登錄
2020-3-21 

論壇贊助勳章
12#
發表於 2016-8-15 23:10 | 只看該作者
回復 11# cdkee

喔...我似乎有點誤會你的意思，我以為是創新高後來拉回多少的紀錄...
我想請問如果遇到以下狀況您希望儲存格如何顯示?
1.資料:0,100,200,300,400,500,600,700,800,900 (無失分)
2.資料:0,100,200,300,400,1000,200,200,200,200 (無大二大失分)
3.資料:0,1000,500,500,2000,1000,1000,500,500,500 (無大三大失分)
真心感謝每一位願意分享所學、指導新手的人!

TOP

        靜思自在 : 原諒別人就是善待自己。
123
返回列表 上一主題