|
- Sub test1() '再来一个,也自动生成
- Dim data, results(), count_() As Long, dict As Object
- Dim i As Long, j As Long, strKey As String
- Dim rowSize As Long, colSize As Long, posRow As Long, posCol As Long
-
- Application.ScreenUpdating = False
-
- Set dict = CreateObject("Scripting.Dictionary")
- data = Sheet1.Range("A1").CurrentRegion.Value
- ReDim results(1 To UBound(data), 1 To 63), count_(1 To UBound(data), 1 To 63)
-
- rowSize = 1
- For colSize = 1 To 2
- results(rowSize, colSize) = data(1, colSize)
- Next
- results(rowSize, colSize) = "查询列"
-
- For i = 2 To UBound(data)
- If Val(data(i, 4)) Then
- strKey = data(i, 1) & data(i, 2)
- If Not dict.Exists(strKey) Then
- rowSize = rowSize + 1
- For j = 1 To 2
- results(rowSize, j) = data(i, j)
- Next
- dict.Add strKey, rowSize
- End If
- posRow = dict(strKey)
- If Day(data(i, 3)) > 20 Then
- strKey = Format(data(i, 3), "YYYY-M-21") & "/" & Format(DateAdd("M", 1, data(i, 3)), "YYYY-M-20")
- Else
- strKey = Format(DateAdd("M", -1, data(i, 3)), "YYYY-M-21") & "/" & Format(data(i, 3), "YYYY-M-20")
- End If
- If Not dict.Exists(strKey) Then
- colSize = colSize + 1
- results(1, colSize) = strKey
- dict.Add strKey, colSize
- End If
- posCol = dict(strKey)
- count_(posRow, posCol) = count_(posRow, posCol) + 1
- results(posRow, posCol) = results(posRow, posCol) + Val(data(i, 4))
- End If
- Next
- For j = 4 To colSize
- For i = 2 To rowSize
- If count_(i, j) Then results(i, j) = results(i, j) / count_(i, j)
- Next
- Next
-
- With Sheet1.Range("G5")
- .CurrentRegion.Clear
- With .Resize(rowSize, colSize)
- .HorizontalAlignment = xlCenter
- .Borders.LineStyle = xlContinuous
- .Value = results
- End With
- End With
-
- Set dict = Nothing
- Application.ScreenUpdating = True
- Beep
- End Sub
复制代码 |
|