|
歡迎轉(zhuǎn)發(fā)和點(diǎn)一下“在看”，文末留言互動(dòng)! 置頂公眾號(hào)或設(shè)為星標(biāo)及時(shí)接收更新不迷路  小伙你們好，今天要分享給大家的是一道VBA題目?，F(xiàn)實(shí)的工作生活中，我們經(jīng)常會(huì)遇到各種排序、排名問題。今天的這道題就是要?jiǎng)討B(tài)按照不同的比例來提取相關(guān)數(shù)據(jù)的題目。 原題是這樣的：  這道題目還稍稍有一些難度。既要考慮名次，又要根據(jù)給定的比例來提取數(shù)據(jù)。 函數(shù)公式處理會(huì)比較麻煩，但是通過VBA則相對(duì)更容易一些。 01 VBA字典 完整代碼如下： Sub 提取成績() Dim i%, d, m%, k%, n, arr As Variant, r, s, w Dim mydic As Object [F:G].Clear Set mydic = CreateObject("scripting.dictionary") arr = Range("A1").CurrentRegion For i = 2 To UBound(arr) r = arr(i, 1) mydic(r) = arr(i, 2) * 100 + i Next s = 0: m = WorksheetFunction.Sum([B2:B26]): n = Range("E1").Value For i = 2 To UBound(arr) d = Application.Large(mydic.items, i - 1) If s < m * n Then s = s + Int(d / 100) w = Application.Match(d, mydic.items, 0) - 1 k = k + 1 Cells(k + 3, 6) = mydic.keys()(w) Cells(k + 3, 7) = Int(mydic.items()(w) / 100) End If NextEnd Sub代碼過程其實(shí)也比較簡單。首先將成績裝入字典，然后再循環(huán)提取、累計(jì)，達(dá)到指定比例后就結(jié)束退出。 For i = 2 To UBound(arr) r = arr(i, 1) mydic(r) = arr(i, 2) * 100 + iNext 裝入字典。鍵值是成績乘以100后再加上對(duì)應(yīng)的序號(hào)。 For i = 2 To UBound(arr) d = Application.Large(mydic.items, i - 1) If s < m * n Then s = s + Int(d / 100) w = Application.Match(d, mydic.items, 0) - 1 k = k + 1 Cells(k + 3, 6) = mydic.keys()(w) Cells(k + 3, 7) = Int(mydic.items()(w) / 100) End IfNext 當(dāng)變量s小于給定值時(shí)，對(duì)變量s進(jìn)行累計(jì)。同時(shí)，按從大到小順序，依次查找變量d在鍵值中的位置信息，從而找到對(duì)應(yīng)的姓名和成績。 經(jīng)過多次循環(huán)，一旦變量s累積量超過給定值，就結(jié)束退出。 我就知道你“在看”  |
|
|
