VBA数组解套

原始数据表

VBA数组解套_第1张图片
源数据

套装构成表

VBA数组解套_第2张图片
套装构成表

要求:【原始数据表】中产品型号为套装的数据,要根据【套装构成表】拆解成所有套装数据,比如【原始数据表】中[A套装],要拆成4条数据,见【套装构成表】中的所有[A套装]构成,同时【原始数据表】中的 [数量] 要和【套装构成表】中 [套装用量]要相乘。

结果:

VBA数组解套_第3张图片
结果

Sub 解套()
    Dim arr, brr, crr(1 To 66666, 1 To 4)
    arr = Sheet1.[a1].CurrentRegion'原始数据表
    brr = Sheet2.[a1].CurrentRegion'套装构成表
    For i = 2 To UBound(arr)
        If InStr(arr(i, 1), "套装") = 0 Then'如果原始数据表中的产品型号不是套装
            k = k + 1'计数
            For j = 1 To UBound(arr, 2)'将整条数据放进crr数组
                crr(k, j) = arr(i, j)
            Next
        Else'如果原始数据表中的产品型号是套装
            For m = 2 To UBound(brr)'遍历套装构成表
                If arr(i, 1) = brr(m, 1) Then'如果是套装名相同
                    k = k + 1'计数,并向数组crr写入数据
                    crr(k, 1) = brr(m, 2)'产品型号
                    crr(k, 2) = arr(i, 2)'客户
                    crr(k, 3) = arr(i, 3) * brr(m, 3)'数量*套装用量
                    crr(k, 4) = arr(i, 4)'日期
                End If
            Next
        End If
    Next
    Sheet3.[a2:d66666].ClearContents'清空数据存放区域
    Sheet3.[A2].Resize(k, 4) = crr'写入拆解后的数据
End Sub
select b.产品型号,a.客户,a.数量*b.套装用量 as 数量,a.交货期 
from [原始表$] a 
inner join 
[套装构成表$] b 
on a.产品型号=b.套装名  
union all  
select 产品型号,客户,数量,交货期 
from  [原始表$] 
where 产品型号 not like "%套装"
VBA数组解套_第4张图片
SQL

示例文件下载:

链接: http://pan.baidu.com/s/1nvsQ3aT 密码: 1g66

你可能感兴趣的:(VBA数组解套)