楼主
liuguansky |
Q：如何依结算价格表分手机品牌拆分销售流水记录？
[以结算价格表中的国代商的不重复清单建立分表，分表的流水记录按销售统计报表中手机品牌与结算价格表中的手机品牌匹配筛选]
A：用如下代码可以实现：
- Sub justtestU()
- Dim arr, ars, dic As New Dictionary, di As New Dictionary, i&, d, d1, arhead, k&, str1$, arrt()
- arhead = Array("销售日期", "分公司", "品牌", "机型", "销售数量（台）", _
- "结算价 （元/台）", "合计（元）", "备注")
- On Error Resume Next
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- With Sheets("ESS终端销售额统计报表")
- ars = .Cells(6, 2).Resize(.Cells(.Rows.Count, 6).End(3).Row - 5, 5).Value
- End With
- With Sheets("结算价格表")
- arr = .Cells(2, 2).Resize(.Cells(.Rows.Count, 2).End(3).Row - 2, 5).Value
- End With
- For i = 1 To UBound(arr, 1)
- If arr(i, 5) <> "国代商" And arr(i, 5) <> "" Then
- If Not dic.Exists(arr(i, 5)) Then dic.Add arr(i, 5), ""
- End If
- Next i
- For Each d In dic.Keys
- k = 0
- Worksheets(d).Delete
- Worksheets.Add after:=Worksheets(Sheets.Count)
- With ActiveSheet
- .Name = d
- .Range("A1").Resize(1, 8) = arhead
- For i = 1 To UBound(arr, 1)
- If arr(i, 5) = d Then
- str1 = "*" & arr(i, 1) & "*" & arr(i, 2) & "*"
- If Not di.Exists(str1) Then di.Add str1, arr(i, 4)
- End If
- Next i
- For i = 1 To UBound(ars, 1)
- str1 = ars(i, 3) & ars(i, 4)
- For Each d1 In di.Keys
- If str1 Like d1 Then
- k = k + 1: ReDim Preserve arrt(1 To 8, 1 To k)
- arrt(2, k) = ars(i, 1): arrt(3, k) = ars(i, 3): arrt(4, k) = ars(i, 4)
- arrt(5, k) = ars(i, 6): arrt(6, k) = di(d1): arrt(7, k) = arrt(5, k) * arrt(6, k): Exit For
- End If
- Next d1
- Next i
- .Cells(2, 1).Resize(k, 8) = Application.Transpose(arrt)
- End With
- di.RemoveAll
- Next
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
具体示例文件如下：
|