日常工作中经常涉及到将纵向数据进行横向填写，方便月度数据汇总，那么将工作表函数运用到vba中十分有效。
image.png
' 出入库数据填写
For n = 4 To [a63356].End(xlUp).Row
For dt = 1 To [d1] - [b1] + 1
'入库填写
Cells(n, 2 * dt + 14) = WorksheetFunction.SumIfs(Worksheets("年成品日出入明细表").Range("l2:l" & icount), _
Worksheets("年成品日出入明细表").Range("a2:a" & icount), Cells(3, 2 * dt + 14), _
Worksheets("年成品日出入明细表").Range("b2:b" & icount), Cells(n, 2), _
Worksheets("年成品日出入明细表").Range("c2:c" & icount), Cells(n, 3), _
Worksheets("年成品日出入明细表").Range("d2:d" & icount), Cells(n, 4), _
Worksheets("年成品日出入明细表").Range("e2:e" & icount), Cells(n, 5) _
)
'出库填写
Cells(n, 2 * dt + 15) = WorksheetFunction.SumIfs(Worksheets("年成品日出入明细表").Range("n2:n" & icount), _
Worksheets("年成品日出入明细表").Range("a2:a" & icount), Cells(3, 2 * dt + 15), _
Worksheets("年成品日出入明细表").Range("b2:b" & icount), Cells(n, 2), _
Worksheets("年成品日出入明细表").Range("c2:c" & icount), Cells(n, 3), _
Worksheets("年成品日出入明细表").Range("d2:d" & icount), Cells(n, 4), _
Worksheets("年成品日出入明细表").Range("e2:e" & icount), Cells(n, 5) _
)
Next dt
Cells(n, "n") = WorksheetFunction.SumIf(Range(Cells(2, "p"), Cells(2, "p").End(xlToRight)), "入", Range(Cells(n, "p"), Cells(n, "p").End(xlToRight)))
Cells(n, "o") = WorksheetFunction.SumIf(Range(Cells(2, "p"), Cells(2, "p").End(xlToRight)), "出", Range(Cells(n, "p"), Cells(n, "p").End(xlToRight)))
Cells(n, "l") = Cells(n, "h") - Cells(n, "n")
Cells(n, "m") = Cells(n, "i") - Cells(n, "o")
Next n
Sub usual()
Dim arr
Dim uniqueArr() As Variant
Dim i As Long, j As Long, n As Long
Dim d As Object
Worksheets("日出入库").Range("a3:cc63356").Clear
icount = Worksheets("年成品日出入明细表").[a63356].End(xlUp).Row
arr = Worksheets("年成品日出入明细表").Range("a2:Q" & icount)
' 初始化数组和字典
Set d = CreateObject("Scripting.Dictionary")
' 使用字典找出不重复的订单号、产品和日期
For i = 1 To UBound(arr)
If arr(i, 2) <> "合计：" And arr(i, 2) <> "总计：" _
And arr(i, 1) >= Worksheets("日出入库").[b1] _
And arr(i, 1) <= Worksheets("日出入库").[d1] _
Then
'将累加相关的值写到item里面
iarr = Array(arr(i, 13), arr(i, 15), arr(i, 16), arr(i, 17))
d(arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6) & "|" & arr(i, 7)) = iarr '组合成键值
End If
Next i
ReDim uniqueArr(1 To d.Count, 1 To 10)
j = 1 '新数组的索引
For Each Key In d.keys
arrkey = Split(Key, "|") '分割键值得到订单号、产品和日期
uniqueArr(j, 1) = arrkey(0) '客户经理
uniqueArr(j, 2) = arrkey(1) '客户名称
uniqueArr(j, 3) = arrkey(2) '订单号
uniqueArr(j, 4) = arrkey(3) '产品型号
uniqueArr(j, 5) = arrkey(4) '加工类型
uniqueArr(j, 6) = arrkey(5) '计划量
uniqueArr(j, 7) = d(Key)(0) '入库累计
uniqueArr(j, 8) = d(Key)(1) '出库累计
uniqueArr(j, 9) = d(Key)(2) '库存
uniqueArr(j, 10) = d(Key)(3) '批次欠产数量
j = j + 1
Next Key
For n = 1 To UBound(uniqueArr)
Worksheets("日出入库").Cells(n + 3, "a") = n
Worksheets("日出入库").Cells(n + 3, "b") = uniqueArr(n, 1)
Worksheets("日出入库").Cells(n + 3, "c") = uniqueArr(n, 2)
Worksheets("日出入库").Cells(n + 3, "D") = uniqueArr(n, 3)
Worksheets("日出入库").Cells(n + 3, "E") = uniqueArr(n, 4)
Worksheets("日出入库").Cells(n + 3, "F") = uniqueArr(n, 5)
Worksheets("日出入库").Cells(n + 3, "G") = uniqueArr(n, 6)
Worksheets("日出入库").Cells(n + 3, "H") = uniqueArr(n, 7)
Worksheets("日出入库").Cells(n + 3, "I") = uniqueArr(n, 8)
Worksheets("日出入库").Cells(n + 3, "J") = uniqueArr(n, 9)
Worksheets("日出入库").Cells(n + 3, "K") = uniqueArr(n, 10)
Next
'将筛选后的日期写到对应单元格
[a3:o3] = Array("序号", "客户经理", "客户名称", "订单号", "产品型号", "加工类型", "计划量", "入库累计", "出库累计", "库存", "批次欠产数量", "结转上月入库", "结转上月出库", "本月入库", "本月出库")
For fday = 1 To [d1] - [b1] + 1
Cells(3, 2 * fday + 14) = [b1] + fday - 1
Cells(3, 2 * fday + 15) = [b1] + fday - 1
Cells(2, 2 * fday + 14) = "入"
Cells(2, 2 * fday + 15) = "出"
Next
' 出入库数据填写
For n = 4 To [a63356].End(xlUp).Row
For dt = 1 To [d1] - [b1] + 1
'入库填写
Cells(n, 2 * dt + 14) = WorksheetFunction.SumIfs(Worksheets("年成品日出入明细表").Range("l2:l" & icount), _
Worksheets("年成品日出入明细表").Range("a2:a" & icount), Cells(3, 2 * dt + 14), _
Worksheets("年成品日出入明细表").Range("b2:b" & icount), Cells(n, 2), _
Worksheets("年成品日出入明细表").Range("c2:c" & icount), Cells(n, 3), _
Worksheets("年成品日出入明细表").Range("d2:d" & icount), Cells(n, 4), _
Worksheets("年成品日出入明细表").Range("e2:e" & icount), Cells(n, 5) _
)
'出库填写
Cells(n, 2 * dt + 15) = WorksheetFunction.SumIfs(Worksheets("年成品日出入明细表").Range("n2:n" & icount), _
Worksheets("年成品日出入明细表").Range("a2:a" & icount), Cells(3, 2 * dt + 15), _
Worksheets("年成品日出入明细表").Range("b2:b" & icount), Cells(n, 2), _
Worksheets("年成品日出入明细表").Range("c2:c" & icount), Cells(n, 3), _
Worksheets("年成品日出入明细表").Range("d2:d" & icount), Cells(n, 4), _
Worksheets("年成品日出入明细表").Range("e2:e" & icount), Cells(n, 5) _
)
Next dt
Cells(n, "n") = WorksheetFunction.SumIf(Range(Cells(2, "p"), Cells(2, "p").End(xlToRight)), "入", Range(Cells(n, "p"), Cells(n, "p").End(xlToRight)))
Cells(n, "o") = WorksheetFunction.SumIf(Range(Cells(2, "p"), Cells(2, "p").End(xlToRight)), "出", Range(Cells(n, "p"), Cells(n, "p").End(xlToRight)))
Cells(n, "l") = Cells(n, "h") - Cells(n, "n")
Cells(n, "m") = Cells(n, "i") - Cells(n, "o")
Next n
Set d = Nothing
End Sub
网友评论