返回列表 上一主題 發帖

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

VBALearner

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

論壇贊助勳章
1# 跳轉到 »
發表於 2016-8-14 10:16 | 顯示全部帖子
回復 1# cdkee

首先由上而下把創新高的儲存格挑出來記錄好數值，再把兩兩創新高儲存格中間範圍的最小值儲存格挑出來計算最大失分，最後再排序出最小值、第二小、第三小的數字顯示出來即可
真心感謝每一位願意分享所學、指導新手的人!

TOP

VBALearner

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

論壇贊助勳章
2#
發表於 2016-8-14 20:36 | 顯示全部帖子
本帖最後由 VBALearner 於 2016-8-14 20:39 編輯

該程式碼設定您的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)
回復 3# cdkee
真心感謝每一位願意分享所學、指導新手的人!

TOP

VBALearner

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

論壇贊助勳章
3#
發表於 2016-8-15 13:34 | 顯示全部帖子
回復 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
複製代碼
真心感謝每一位願意分享所學、指導新手的人!

TOP

VBALearner

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

論壇贊助勳章
4#
發表於 2016-8-15 14:58 | 顯示全部帖子
本帖最後由 VBALearner 於 2016-8-15 15:02 編輯

回復 8# cdkee

i是資料最左邊的起始欄位編號，D欄就是4
資料位置跟...的部分就依照你的需要自行改寫吧~
  1. i = 4
  2. do while cells(20,i) <> ""
  3.    
  4.     ...'計算失分程式

  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  
複製代碼
真心感謝每一位願意分享所學、指導新手的人!

TOP

VBALearner

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

論壇贊助勳章
5#
發表於 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

VBALearner

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

論壇贊助勳章
6#
發表於 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

VBALearner

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

論壇贊助勳章
7#
發表於 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

VBALearner

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

論壇贊助勳章
8#
發表於 2016-8-16 20:42 | 顯示全部帖子
回復 19# cdkee

我說您也稍微了解一下VBA基本的型態限制吧= ="
用integer無法計算到這麼大的數字，宣告變數要改成哪個型態網站上有寫
http://edisonx.pixnet.net/blog/post/42112370-vba-%E5%9F%BA%E6%9C%AC%E8%B3%87%E6%96%99%E5%9E%8B%E6%85%8B
真心感謝每一位願意分享所學、指導新手的人!

TOP

        靜思自在 : 修行要繫緣修心，藉事練心，隨處養心。
返回列表 上一主題