|
- Sub test()
- Dim rawdata, i As Long, d As Object, d1 As Object
- Dim re(), ym As String, ymPro As String
- Set d = CreateObject("scripting.dictionary"): Set d1 = CreateObject("scripting.dictionary")
- rawdata = Sheets("费用").Range("A1").CurrentRegion.Value
- ReDim re(1 To UBound(rawdata), 1 To 1)
- re(1, 1) = "平摊费用"
- For i = 2 To UBound(rawdata)
- ym = Format(rawdata(i, 1), "yyyymm")
- If rawdata(i, 4) <> "公司费用" And rawdata(i, 3) <> "其他" Then
- ymPro = ym & rawdata(i, 3)
- If Not d.exists(ymPro) Then d1(ym) = d1(ym) + 1
- d(ym & rawdata(i, 3)) = d(ym & rawdata(i, 3)) + 1
- Else
- d(ym) = rawdata(i, 5)
- End If
- Next
- For i = 2 To UBound(rawdata)
- ym = Format(rawdata(i, 1), "yyyymm")
- If rawdata(i, 4) <> "公司费用" And rawdata(i, 3) <> "其他" Then
- If d.exists(ym) Then
- re(i, 1) = rawdata(i, 5) + d(ym) / d1(ym) / d(ym & rawdata(i, 3))
- Else
- re(i, 1) = rawdata(i, 5)
- End If
- End If
- Next
- Range("F1").Resize(UBound(re)) = re
- End Sub
复制代码 |
|