cdkee

回復 7# VBALearner
回復 5# GBKEE
用GBKEE版大的去修改，也是不行，請教各大大如何改寫，謝謝!

test5G.rar (14.6 KB)

下載次數: 2

2016-8-15 19:02

VBALearner

回復 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 (無大三大失分)

cdkee

回復 12# VBALearner

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

VBALearner

回復 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)

下載次數: 2

2016-8-16 00:47

cdkee

回復 14# VBALearner

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

下載次數: 3

2016-8-16 10:56

VBALearner

回復 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
   
5. 
   
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
    
51. 
    
52. Sub 紀錄()
    
53.     失分 = Z
    
54.     紀錄上界 = i
    
55.     紀錄下界 = j
    
56. End Sub

複製代碼

失分計算.zip (21.49 KB)

下載次數: 3

2016-8-16 11:57

cdkee

回復 16# VBALearner
謝謝大大不厭小弟煩而幫助，大大的最終版小弟仍在了解中。
想表示回覆哪位大大，只要在那位大大留言按"回覆"，之後COPY個URL，再複製到自己的回覆內容就可以。
再謝謝VBALearner大大!

stillfish00

回復 15# cdkee
看不懂你的邏輯
第一組2016/5/5開始 1000,900,700,800,600,300
700到800有得分啊，結果你用1000-300=700失分
而不是分為 1000-700 , 800-300 這兩組失分

cdkee

回復 16# VBALearner

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

下載次數: 4

2016-8-16 14:23

cdkee

回復  cdkee
看不懂你的邏輯
第一組2016/5/5開始 1000,900,700,800,600,300
700到800有得分啊，結果你用 ...
stillfish00 發表於 2016-8-16 14:16

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