[已解决]能否实现按顺序的列数据填充到奇数的列中？

hxgfkfb

附件中上表的数据是按从A到K的顺序排列的，想实现将这些列的数据添加到下表中绿色底纹的列中，并求和，能否实现？谢谢 Book1.rar (9.78 KB, 下载次数: 9)

2016-4-22 10:48 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2016-4-22 18:50

1. Sub Macro1()
   
2. Dim arr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a3:k18]
   
5. For j = 2 To UBound(arr, 2)
   
6.     arr(1, j) = Replace(arr(1, j), "合计", "实际")
   
7. Next
   
8. For i = 2 To UBound(arr)
   
9.     For j = 2 To UBound(arr, 2)
   
10.         zf = arr(i, 1) & "," & arr(1, j)
    
11.         d(zf) = arr(i, j)
    
12.     Next
    
13. Next
    
14. For j = 3 To 19 Step 2
    
15.     For i = 24 To 38
    
16.         zf = Cells(i, 1) & "," & Cells(22, j)
    
17.         Cells(i, j) = d(zf)
    
18.     Next
    
19.     Cells(39, j) = Application.Sum(Cells(24, j).Resize(15, 1))
    
20. Next
    
21. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a3:k18]
   
5. For j = 2 To UBound(arr, 2)
   
6.     arr(1, j) = Replace(arr(1, j), "合计", "实际")
   
7. Next
   
8. For i = 2 To UBound(arr)
   
9.     For j = 2 To UBound(arr, 2)
   
10.         zf = arr(i, 1) & "," & arr(1, j)
    
11.         d(zf) = arr(i, j)
    
12.     Next
    
13. Next
    
14. For j = 3 To 19 Step 2
    
15.     For i = 24 To 38
    
16.         zf = Cells(i, 1) & "," & Cells(22, j)
    
17.         Cells(i, j) = d(zf)
    
18.     Next
    
19.     Cells(39, j) = Application.Sum(Cells(24, j).Resize(15, 1))
    
20. Next
    
21. End Sub

复制代码