如何用VBA把来源表一做成表二保留表一

wooikeat9128

请老师帮忙,希望从表一做成新的表二先谢谢
F2:F11 去重复
G1:J1 去重复
G2:J11 去重复,对照日期跟客户得到业务员数量

shuidisyy

这样问题应该用透视表，拖几下的事，唉，代码写的我自己都累

1. Sub test()
   
2.     Dim i%, j%, arrData, arrResult, n%, k%, arrT, x%, y%
   
3.     Dim dicx As Object, dicy As Object, d
   
4.     Set dicx = CreateObject("scripting.dictionary")
   
5.     Set dicy = CreateObject("scripting.dictionary")
   
6.     arrData = Range("a1").CurrentRegion.Value
   
7.     ReDim arrResult(1 To UBound(arrData), 1 To 10)
   
8.     ReDim arrT(1 To UBound(arrData), 1 To 2)
   
9.     arrResult(1, 1) = "Date"
   
10.     arrT(1, 1) = "Deal Number of customers": arrT(1, 2) = "Deal Amount"
    
11.     k = 1: n = 1
    
12.     For i = 2 To UBound(arrData)
    
13.         If Not dicy.exists(arrData(i, 4)) Then
    
14.             k = k + 1
    
15.             dicy(arrData(i, 4)) = k
    
16.             arrResult(1, k) = arrData(i, 4)
    
17.         End If
    
18.         y = dicy(arrData(i, 4))
    
19.         d = Format(arrData(i, 1), "m/yyyy")
    
20.         If Not dicx.exists(d) Then
    
21.             n = n + 1
    
22.             dicx(d) = n
    
23.             arrResult(n, 1) = d
    
24.         End If
    
25.         x = dicx(d)
    
26.         arrResult(x, y) = arrResult(x, y) + 1
    
27.         arrT(x, 2) = arrData(i, 3) + arrT(x, 2)
    
28.         arrT(x, 1) = 1 + arrT(x, 1)
    
29.     Next i
    
30.     Range("n1").Resize(Rows.Count, k + 2).ClearContents
    
31.     Range("n1").Resize(n, k) = arrResult
    
32.     Range("n1").Offset(, k).Resize(n, 2) = arrT
    
33. End Sub
    

复制代码

wooikeat9128

老师您太厉害了,就是要这样,因为没有钱买高版本OFFICE,不能用Power Query,因此要用VBA,感谢您,好人一生平安