如何依活动记录分月返回组织交叉明细？

作者：绿色风分类：时间：2022-08-17 浏览：126

楼主
liuguansky

Q:如何依活动记录分月返回组织交叉明细？
一个工作表中是活动记录的流水明细，[因为是预算活动，并不一定按时间顺序]，希望能在另一张表中返回各机构各月的所有活动明细，返回成机构与月份的交叉明细，如何返回？
A:用如下代码可以实现：

Sub justtest()
'字典对象前期绑定，引用VBE工具下msscripting.runtime
Dim d As New Dictionary, Arr, i&, ArrR(), Nf%, K&, Cn As Byte
'定义变量
Nf = CInt([a1].Value)
'获取查询年份
With Sheets("活动明细")
Arr = .Range("a2:g" & .Cells(.Rows.Count, 1).End(3).Row).Value
'活动明细赋值予数组
End With
For i = 1 To UBound(Arr, 1) '循环活动明细
If Arr(i, 3) = Nf Then '如果年度符合查询
If Not d.Exists(Arr(i, 2)) Then '如果字典KEY不存在组织名称
K = K + 1: d.Add Arr(i, 2), K '累加计数，添加组织名称入字典KEY
ReDim Preserve ArrR(1 To 25, 1 To K) '动态扩展结果数组
ArrR(1, K) = Arr(i, 2) '新组织名称赋值
End If
Cn = Arr(i, 4) * 2 '根据月份，判断返回列号
If ArrR(Cn, d(Arr(i, 2))) <> "" Then '如果之前有活动内容
ArrR(Cn, d(Arr(i, 2))) = ArrR(Cn, d(Arr(i, 2))) & vbCrLf & Arr(i, 5)
'则进行连接
Else: ArrR(Cn, d(Arr(i, 2))) = Arr(i, 5)
'否则，直接赋值
End If
If ArrR(Cn + 1, d(Arr(i, 2))) <> "" Then '同上判断
ArrR(Cn + 1, d(Arr(i, 2))) = ArrR(Cn + 1, d(Arr(i, 2))) & vbCrLf & Arr(i, 7)
Else: ArrR(Cn + 1, d(Arr(i, 2))) = Arr(i, 7)
End If
End If
Next i
Range("a3:y" & Rows.Count).ClearContents
If K > 0 Then Range("a3").Resize(K, 25) = Application.Transpose(ArrR)
End Sub

2楼
JOYARK1958

謝謝提供學習下載中

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表