Excel數組公式爲條件求和然後排序

-2

尋找Excel數組公式將每個「代碼」的「權重」加總並按權重順序對「代碼」進行排序。Excel數組公式爲條件求和然後排序

| A | B | C | D | E | 
|1 | Code | Weight |  | Code |TotWeight| 
|2 | 444 | 30 |  | 444 | 50 | 
|3 | 333 | 10 |  | 222 | 40 |  
|4 | 222 | 10 |  | 333 | 40 | 
|5 | 444 | 10 |  | 555 | 20 |   
|6 | 444 | 10 | 
|7 | 222 | 30 | 
|8 | 333 | 20 | 
|9 | 555 | 20 | 
|10| 333 | 10 |

列A和B是輸入，D和E是輸出。

來源

2016-09-17 Sammy

雖然這可能最終是一個複雜的計算密集型數組公式，但對於所有意圖和目的，您真的試圖用SUM，GROUP BY和ORDER BY子句來實現數據庫SELECT語句。喜歡的東西，

SELECT code, weight FROM 
(SELECT cw.code, Sum(cw.weight) AS weight 
    FROM tblCodeWeights AS cw 
    GROUP BY cw.code) 
ORDER BY weight DESC, code;

我會建議利用ADODB.Connection到能產生你想要達到的結果工作表中的VBA子過程。下面的代碼是詳細的，可能會稍微修剪一下，但操作的每個方面都要處理，應該是不言自明的或易於研究的。

Option Explicit 

Sub sortedFilteredSums() 
    Dim cnx As Object, rs As Object 
    Dim sWS1 As String, sWB As String, sCNX As String, sSQL As String 
    Dim ws1TBLaddr As String 

    With Worksheets("Sheet8") 
     ws1TBLaddr = .Cells(1, 1).CurrentRegion.Address(0, 0) 
     sWS1 = Worksheets("Sheet8").Name 
    End With 

    sWB = ThisWorkbook.FullName 
    sCNX = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sWB _ 
     & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 
    Debug.Print sCNX 

    Set cnx = CreateObject("ADODB.Connection") 
    Set rs = CreateObject("ADODB.Recordset") 

    cnx.Open sCNX 

    sSQL = "SELECT [code], [weight] FROM (" 
    sSQL = sSQL & " SELECT cw.[code], SUM(cw.[weight]) AS [weight]" 
    sSQL = sSQL & " FROM [" & sWS1 & "$" & ws1TBLaddr & "] cw" 
    sSQL = sSQL & " GROUP BY cw.code" 
    sSQL = sSQL & ") ORDER BY [weight] DESC, [code]" 

    Debug.Print sSQL 
    'SELECT code, weight FROM 
    ' (SELECT cw.code, Sum(cw.weight) AS weight 
    ' FROM tblCodeWeights AS cw 
    ' GROUP BY cw.code) 
    'ORDER BY weight DESC, code; 

    rs.Open sSQL, cnx 

    With Worksheets("Sheet8") 
     .Range("D1").Resize(1, 2) = Array("code", "totweight") 
     .Range("D2").CopyFromRecordset rs 
    End With 

    rs.Close: Set rs = Nothing 
    cnx.Close: Set cnx = Nothing 

End Sub

請注意，這不能在尚未保存的工作簿上執行;例如而不是在一個新的無標題的工作簿上。你的結果應該類似於以下內容。