|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub test2()
-
- Dim data, Dict As Object
- Dim i As Long, j As Long, sKey As String
- Dim posRow As Long, rowSize As Long, colSize As Long
-
- Set Dict = CreateObject("Scripting.Dictionary")
- data = Sheet1.Range("A1").CurrentRegion
-
- rowSize = 1
- colSize = 1
- data(rowSize, colSize) = data(1, 2)
-
- For j = 4 To UBound(data, 2)
- colSize = colSize + 1
- data(rowSize, colSize) = data(1, j)
- Next
-
- For i = 2 To UBound(data)
- sKey = data(i, 2)
- If Dict.Exists(sKey) Then
- posRow = Dict(sKey)
- For j = 4 To UBound(data, 2)
- data(posRow, j - 2) = data(posRow, j - 2) + Val(data(i, j))
- Next
- Else
- rowSize = rowSize + 1
- data(rowSize, 1) = sKey
- For j = 4 To UBound(data, 2)
- data(rowSize, j - 2) = Val(data(i, j))
- Next
- Dict.Add sKey, rowSize
- End If
-
- Next
-
- With Sheet2.Range("A1")
- .CurrentRegion.Clear
- With .Resize(rowSize, colSize)
- .Borders.LineStyle = xlContinuous
- .HorizontalAlignment = xlCenter
- .Rows(1).Font.Bold = True
- .Value = data
- End With
- End With
-
- Set Dict = Nothing
- Beep
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-2-22 17:24
楼主
