数据合并计算php,各位大神,求助如果用VBA实现以下数据合并以及数量计算

Option Explicit

''ModuleName="模块1"

Dim aData, dic As Object, aRes

Sub start()

Dim i&, n&, aTmp, minNum, maxNum

Dim spNum&, strData, id, num

aData = Range("a1").CurrentRegion

Set dic = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(aData)

strData = strData_let(i)

aTmp = Split(aData(i, 1), ".")

id = aTmp(0)

spNum = aTmp(1)

num = aData(i, 2)

If Not dic.exists(id) Then

Set dic(id) = CreateObject("Scripting.Dictionary")

End If

If Not dic(id).exists(strData) Then

Set dic(id)(strData) = CreateObject("Scripting.Dictionary")

End If

dic(id)(strData)(spNum) = num

Next

ReDim aRes(1 To UBound(aData), 1 To 6)

For Each id In dic.keys

For Each strData In dic(id).keys

num = 0

For Each aTmp In dic(id)(strData).items

num = num + aTmp

Next

n = n + 1

If dic(id)(strData).Count > 1 Then

minNum = Format(Application.Min(dic(id)(strData).keys), "000")

maxNum = Format(Application.Max(dic(id)(strData).keys), "000")

aRes(n, 1) = id & "." & minNum & "-" & maxNum

Else

aRes(n, 1) = id & "." & Format(dic(id)(strData).keys()(0), "000")

End If

aRes(n, 2) = num

strData_get strData, n

Next

Next

Range("H2").Resize(n, 6) = aRes

End Sub

Function strData_let(r&)

Dim c&

For c = 3 To UBound(aData, 2)

strData_let = strData_let & "|" & aData(r, c)

Next

End Function

Sub strData_get(s, r&)

Dim arr, i&

arr = Split(s, "|")

For i = 1 To UBound(arr)

aRes(r, 2 + i) = arr(i)

Next

End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值