[已解决]分类统计及日期匹配

moonofwell

需求说明：

1、首先跟据“项目信息”sheet中各个项目的“项目编码”（项目编码和项目名称是唯一对应、保持一致的）进行分类统计，并将分类结果放到“项目回款时间统计”sheet中（“已回款”的项目不需统计），并根据项目编号进行排序；

2、然后根据“项目回款时间统计”sheet中的项目编号，将“项目信息”sheet中的各个项目的具体“项目回款额”，根据具体的回款日期，放到“项目回款时间统计”sheet中的对应日期单元格。

请各位高手指点指点，多谢，详见附件。


分类统计及日期匹配.rar (10.74 KB, 下载次数: 9)

2014-4-22 11:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-22 13:19

………………

跳转到最佳答案楼层

yuan1987

为啥不用数透？

gdw831001

C1=SUMPRODUCT(($A2=项目信息!$A$2:$A$11)*(项目信息!$E$2:$E$11=项目回款时间统计!C$1)*项目信息!$D$2:$D$11)

tgydslr

C2

1. =TEXT(SUM(IFERROR((项目信息!$B$2:$B$12=$B2)*(项目信息!$E$2:$E$11=C$1)*项目信息!$D$2:$D$12,)),"0;;")

复制代码

三键下拉

tgydslr

分类统计及日期匹配.rar (12.2 KB, 下载次数: 3)

2014-4-22 12:56 上传

点击文件名下载附件

风林火山

透视表好像能解决这个问题

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, d2, i&, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Sheet1.Range("a1").CurrentRegion
   
6. Sheet2.Activate
   
7. brr = Range("a1").CurrentRegion
   
8. For i = 2 To UBound(arr)
   
9.     zf = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 5)
   
10.     d(zf) = arr(i, 4)
    
11.     d2(arr(i, 1) & "," & arr(i, 2)) = ""
    
12. Next
    
13. ReDim crr(1 To d2.Count, 1 To UBound(brr, 2))
    
14. a = d2.keys
    
15. For i = 0 To d2.Count - 1
    
16.     x = Split(a(i), ",")
    
17.     crr(i + 1, 1) = x(0)
    
18.     crr(i + 1, 2) = x(1)
    
19.     For j = 3 To UBound(brr, 2)
    
20.         zf = a(i) & "," & brr(1, j)
    
21.         crr(i + 1, j) = d(zf)
    
22.     Next
    
23. Next
    
24. Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
    
25. Range("a1").Resize(UBound(crr) + 1, UBound(crr, 2)).Sort [a1], Header:=xlGuess
    
26. End Sub
    

复制代码

dsmch

………………

moonofwell

dsmch 发表于 2014-4-22 13:19
………………

多谢，但是“已回款”的的项目不需要显示到“项目回款时间统计”sheet中，现在是所有项目都显示出来了，您再帮忙看看能不能处理一下，多谢：）

dsmch

Sub Macro1()
Dim arr, brr, crr, d, d2, i&, zf$
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion
Sheet2.Activate
brr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
    zf = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 5)
    d(zf) = arr(i, 4)
    If arr(i, 5) <> "已回款" Then d2(arr(i, 1) & "," & arr(i, 2)) = ""
Next
ReDim crr(1 To d2.Count, 1 To UBound(brr, 2))
a = d2.keys
For i = 0 To d2.Count - 1
    x = Split(a(i), ",")
    crr(i + 1, 1) = x(0)
    crr(i + 1, 2) = x(1)
    For j = 3 To UBound(brr, 2)
        zf = a(i) & "," & brr(1, j)
        crr(i + 1, j) = d(zf)
    Next
Next
Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
Range("a1").Resize(UBound(crr) + 1, UBound(crr, 2)).Sort [a1], Header:=xlGuess
End Sub