[已解决]跳过隐藏列进行批量粘贴

心灵有约

跳过隐藏列粘贴.rar (9.82 KB, 下载次数: 21)

2016-3-28 21:19 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2016-3-28 21:52

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     For j = 2 To UBound(arr, 2)
   
8.         zf = arr(i, 1) & "," & arr(1, j)
   
9.         d(zf) = arr(i, j)
   
10.     Next
    
11. Next
    
12. For i = 2 To UBound(brr)
    
13.     For j = 2 To UBound(brr, 2)
    
14.         zf = brr(i, 1) & "," & brr(1, j)
    
15.         If d.exists(zf) Then
    
16.             brr(i, j) = d(zf)
    
17.         Else
    
18.             n = d("合计" & "," & brr(1, j - 1))
    
19.             brr(i, j) = Format(brr(i, j - 1) / n, "0.00%")
    
20.         End If
    
21.     Next
    
22. Next
    
23. Sheet2.Range("a1").CurrentRegion = brr
    
24. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     For j = 2 To UBound(arr, 2)
   
8.         zf = arr(i, 1) & "," & arr(1, j)
   
9.         d(zf) = arr(i, j)
   
10.     Next
    
11. Next
    
12. For i = 2 To UBound(brr)
    
13.     For j = 2 To UBound(brr, 2)
    
14.         zf = brr(i, 1) & "," & brr(1, j)
    
15.         If d.exists(zf) Then
    
16.             brr(i, j) = d(zf)
    
17.         Else
    
18.             n = d("合计" & "," & brr(1, j - 1))
    
19.             brr(i, j) = Format(brr(i, j - 1) / n, "0.00%")
    
20.         End If
    
21.     Next
    
22. Next
    
23. Sheet2.Range("a1").CurrentRegion = brr
    
24. End Sub

复制代码