|
- Sub test11() 'Array + Dictionary
- Dim result(), data, dict As Object, strKey As String, i As Long, j As Long
- Dim rowSize As Long, colSize As Long, posRow As Long, posCol As Long
-
- Application.ScreenUpdating = False
-
- Set dict = CreateObject("Scripting.Dictionary")
- data = Sheet14.Range("A1").CurrentRegion.Value
-
- With CreateObject("Excel.Sheet") '''''''''''''''''''''加,用于排序
- With .Worksheets(1).Range("A1").Resize(UBound(data), UBound(data, 2))
- .Value = data
- .Sort .Item(7), xlAscending, , , , , , xlYes
- data = .Value
- End With
- .Close
- End With '''''''''''''''''''''''''''''''''''''''''''''''
-
- ReDim result(1 To UBound(data), 1 To 800)
- rowSize = 1
- colSize = 1
- result(rowSize, colSize) = data(1, 1)
- For i = 2 To UBound(data)
- strKey = Trim(data(i, 1))
- If Not dict.Exists(strKey) Then
- rowSize = rowSize + 1
- result(rowSize, 1) = strKey
- dict.Add strKey, rowSize
- End If
- posRow = dict(strKey)
- strKey = Trim(data(i, 7))
- If strKey <> "" Then '加
- If Not dict.Exists(strKey) Then
- colSize = colSize + 1
- result(1, colSize) = strKey
- dict.Add strKey, colSize
- End If
- posCol = dict(strKey)
- result(posRow, posCol) = result(posRow, posCol) + Val(data(i, 10))
- End If '加
- Next
- 'rowSize = rowSize + 1
- colSize = colSize + 1
- 'result(rowSize, 1) = "总计"
- result(1, colSize) = "总计"
- For j = 2 To colSize - 1
- For i = 2 To rowSize '- 1
- 'result(rowSize, j) = result(rowSize, j) + result(i, j)
- result(i, colSize) = result(i, colSize) + result(i, j)
- Next
- 'result(i, colSize) = result(i, colSize) + result(i, j)
- Next
- With Sheet15.Range("A1")
- .CurrentRegion.Clear
- With .Resize(rowSize, colSize)
- .HorizontalAlignment = xlCenter
- .Borders.LineStyle = xlContinuous
- .Rows(1).Font.Bold = True
- '.Columns(1).Font.Bold = True
- .Value = result
- .Resize(rowSize).Sort .Item(1), xlAscending, , , , , , xlYes
- .Columns.AutoFit
- End With
- End With
- Set dict = Nothing
-
- Application.ScreenUpdating = True
- Beep
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|