怎么将原档转换成附件格式,有没有更简单的方法！

puzhixin520

将"数据源"的数据整理成附件格式,有没有更简单的方法,求大神帮忙！

chxw68

看不懂之间的对应关系。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr(), crr()
   
4.   Application.ScreenUpdating = False
   
5.   Application.DisplayAlerts = False
   
6.   vs = [{37,-1,4;44,1,20;49,1,36}]
   
7.   With Worksheets("数据源")
   
8.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
10.     arr = .Range("a2").Resize(r - 1, c)
    
11.   End With
    
12.   ReDim brr(1 To UBound(vs))
    
13.   For k = 1 To UBound(vs)
    
14.     ReDim crr(1 To 10000, 1 To 15)
    
15.     m = 1
    
16.     n = 1
    
17.     For i = 1 To UBound(arr)
    
18.       crr(m, n) = arr(i, vs(k, 1)) * vs(k, 2)
    
19.       n = n + 1
    
20.       If n > 15 Then
    
21.         n = 1
    
22.         m = m + 1
    
23.       End If
    
24.     Next
    
25.     brr(k) = crr
    
26.   Next
    
27.   With Worksheets("整理")
    
28.     For k = 1 To UBound(vs)
    
29.       crr = brr(k)
    
30.       .Cells(9, vs(k, 3)).Resize(UBound(crr), UBound(crr, 2)) = crr
    
31.     Next
    
32.   End With
    
33. End Sub
    
34. 
    

复制代码

chxw68

详见附件。