楼主
liuguansky |
Q:如何把商品流水记录按仓库分隔开来，需要达到两种效果：
A:用如下代码可以实现：- Sub justtest()
- Dim Arr, D, i&, ArrR(1 To 60000, 1 To 240) As String, j As Byte, iR&, iC As Byte, K&
- '定义变量
- Set D = CreateObject("scripting.dictionary")
- '创建字典项目
- Arr = Range("A1").CurrentRegion.Value
- '获取待处理数据
- For i = 2 To UBound(Arr, 1) '循环数据
- If D.exists(Arr(i, 1)) Then '如果仓库存在
- D(Arr(i, 1)) = Array(D(Arr(i, 1))(0), D(Arr(i, 1))(1) + 1)
- '对个数累加
- Else '否则
- K = D.Count * 5 + 1 '获取仓库添加位置即行数
- D.Add Arr(i, 1), Array(K, 1) '添加新仓库入字典KEY，同时初始化ITEM
- For j = 1 To 4 '填写仓库记录表头
- ArrR(K, j) = Arr(1, j)
- Next j
- End If
- iR = (D(Arr(i, 1))(1) - 1) Mod 4 + 1 '判断行号
- iC = Application.RoundUp(D(Arr(i, 1))(1) / 4, 0) '判断列号
- For j = 1 To 4
- ArrR(D(Arr(i, 1))(0) + iR, iC * 5 - 5 + j) = Arr(i, j) '返回本行记录至结果数组
- Next j
- Next i
- Range([f1], Cells(Cells.Count)).ClearContents
- Range("f1").Resize(D.Count * 5, 240) = ArrR
- Set D = Nothing
- End sub
- Sub justtest1()
- Dim Arr, D, i&, ArrR(1 To 60000, 1 To 14) As String, Dt, K&, iR&, iC As Byte, j As Byte
- '定义变量
- Set D = CreateObject("scripting.dictionary")
- '创建字典项目
- Arr = Range("A1").CurrentRegion.Value
- '获取待处理数据源入数组
- For i = 2 To UBound(Arr, 1) '循环数组，添加字典项目，并累加计数
- D(Arr(i, 1)) = D(Arr(i, 1)) + 1
- Next i
- s = 0 '初始化标识符
- For Each Dt In D.keys '循环字典KEY项目
- K = 0: K = K + 1 '初始化各KEY值标识符，同时累加
- For j = 1 To 4 '生成记录表头
- ArrR(s + K, j) = Arr(1, j)
- Next j
- For i = 2 To UBound(Arr, 1) '循环数据源
- If Arr(i, 1) = Dt Then '如果满足KEY
- K = K + 1 '累加记录行
- iR = (K - 1) Mod 5 + 1 + Int((K - 1) / 15) * 5 '返回行号
- iC = Int(((K - 1) Mod 15) / 5) * 5 '返回列号
- For j = 1 To 4 '记录赋值入数组
- ArrR(s + iR, iC + j) = Arr(i, j)
- Next j
- End If
- Next i
- s = s + Application.RoundUp((D(Dt) + 1) / 15, 0) * 5 '对整体记录进行累加
- Next
- Range([f1], Cells(Cells.Count)).ClearContents
- Range("f1").Resize(s, 14) = ArrR
- Set D = Nothing
- End Sub Sub
该帖已经同步到 liuguansky的微博 |