骨子纲领自慰 自拍

成人游戏多条款汇总，汇总成果排序|完好代码

1、在责任表Sheet1里，大叫按钮点击事件，调用汇总历程：

Private Sub CmdSum1_Click()    Call mySum1End SubPrivate Sub CmdSum2_Click()    Call mySum2End Sub

2、在myModule里，mySum1历程，通过数组、字典、责任表排序措施，汇总和据：

Sub mySum1()    Dim ws As Worksheet， lastRow As Integer， lastCol As Integer    Dim dic As Object， dKey1， dKey2    Dim arr()， temp()， str() As String， rng As Range    Set ws = ThisWorkbook.Sheets("Sheet1")    Set dic = CreateObject("Scripting.Dictionary")    With ws        lastRow = .UsedRange.Rows.Count        lastCol = 5        arr = .Range(.Cells(1， 1)， .Cells(lastRow， lastCol)).Value    End With    For i = 2 To UBound(arr)        If arr(i， 1) <> "" Then            dKey1 = arr(i， 1) & "|" & arr(i， 2)            If Not dic.exists(dKey1) Then                dic.Add dKey1， CreateObject("Scripting.Dictionary")            End If                        For j = 3 To 5                dKey2 = arr(1， j)                dic(dKey1)(dKey2) = dic(dKey1)(dKey2) + arr(i， j)            Next        End If    Next    ReDim temp(1 To dic.Count + 1， 1 To lastCol)    For i = 1 To lastCol        temp(1， i) = arr(1， i)    Next    m = 1    For Each dKey1 In dic.keys        str = Split(dKey1， "|")        m = m + 1        temp(m， 1) = str(0)        temp(m， 2) = str(1)        For i = 3 To 5            dKey2 = temp(1， i)            temp(m， i) = dic(dKey1)(dKey2)        Next    Next    ws.Range("J1").Resize(lastRow， lastCol).ClearContents    Set rng = ws.Range("J1").Resize(UBound(temp)， UBound(temp， 2))    With rng        .Value2 = temp        Call SortRange(rng， .Columns(1)， .Columns(2))    End WithEnd Sub

3、在myModule里，SortRange历程，通过两个要道字对一个Range进行排序，不错聘任数据是否包括标题行，默许包含：

Sub SortRange( _        rng As Range， _        primarySortKey As Range， _        secondarySortKey As Range， _        Optional IncludeHeader As Boolean = True)    '//按两列排序，默许数据包含标题    Dim ws As Worksheet    Set ws = rng.Parent    With ws.Sort        .SortFields.Clear        .SortFields.Add _            Key:=primarySortKey， _            SortOn:=xlSortOnValues， _            Order:=xlAscending， _            DataOption:=xlSortNormal        .SortFields.Add _            Key:=secondarySortKey， _            SortOn:=xlSortOnValues， _            Order:=xlAscending， _            DataOption:=xlSortNormal        .SetRange rng        If IncludeHeader Then            .Header = xlYes        Else            .Header = xlNo        End If        .MatchCase = False        .Orientation = xlTopToBottom        .SortMethod = xlPinYin        .Apply    End WithEnd Sub

4、在myModule里自慰 自拍，mySum2历程，通过数组、SortedList措施，汇总和据：

Sub mySum2()    Dim ws As Worksheet， lastRow As Integer， lastCol As Integer    Dim lst As Object， key1， key2    Dim arr()， temp()， str， rng As Range    Set ws = ThisWorkbook.Sheets("Sheet1")    Set lst = CreateObject("System.Collections.SortedList")    With ws        lastRow = .UsedRange.Rows.Count        lastCol = 5        arr = .Range(.Cells(1， 1)， .Cells(lastRow， lastCol)).Value    End With    For i = 2 To UBound(arr)        If arr(i， 1) <> "" Then            key1 = arr(i， 1) & "|" & arr(i， 2)            If Not lst.contains(key1) Then                lst.Add key1， CreateObject("System.Collections.SortedList")            End If                        For j = 3 To 5                key2 = arr(1， j)                lst.Item(key1).Item(key2) = lst.Item(key1).Item(key2) + arr(i， j)'                lst(key1)(key2) = lst(key1)(key2) + arr(i， j)            Next        End If    Next    ReDim temp(1 To lst.Count + 1， 1 To lastCol)    For i = 1 To lastCol        temp(1， i) = arr(1， i)    Next    For i = 0 To lst.Count - 1        key1 = lst.getkey(i)        str = Split(key1， "|")        temp(i + 2， 1) = str(0)        temp(i + 2， 2) = str(1)        For j = 3 To 5            key2 = temp(1， j)            temp(i + 2， j) = lst.Item(key1).Item(key2)            'temp(i + 2， j) = lst(key1)(key2)        Next    Next    ws.Range("J1").Resize(lastRow， lastCol).ClearContents    Set rng = ws.Range("J1").Resize(UBound(temp)， UBound(temp， 2))    With rng        .Value2 = temp    End WithEnd Sub

~~~~~~End~~~~~~ 本站仅提供存储行状，总共骨子均由用户发布，如发现存害或侵权骨子，请点击举报。