[已解决]这样的表格用数组填充不了了 怎么不覆盖其他值

markang

各位老师好!

如果我要将一个一维数组填充到表1的range("a1:h15"),同时不能触碰其他不相关的单元格,下面的代码应该怎么修改呢
原来的代码如下,已经很好的解决了"把一维数组按照一定规律放进方阵的问题" 但是这样子会把不相关的单元格直接显示成"空值",小弟工作中遇到的表格就是这样---在不相关区域有重要的内容,所以用现在这个方法的话会把要显示的内容直接抹掉了
PS,附件表格的黄色只是我标出来做醒目用的,现实表格上没有,请不要以"以颜色定位"的方法处理此问题,谢谢.

这样的表格用数组填充不了了 怎么不覆盖其他值.rar (14.16 KB, 下载次数: 2)

2015-6-21 10:00 上传

点击文件名下载附件
Sub tt()

    Dim arr, y, n, brr
     arr = Application.Transpose(Sheet2.Range("a2:a16"))
  
    ReDim brr(1 To WorksheetFunction.RoundUp(UBound(arr) / 3, 0) * 10 - 9, 1 To 7)
     n = 1
     k = -2
     For y = 1 To UBound(arr)
         k = k + 3
         If k > 7 Then k = 1: n = n + 10
         brr(n, k) = arr(y)
     Next y
     Range("b2").Resize(n, 7) = brr

End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2015-6-21 10:35

1. Sub tt()
   
2. 
   
3.     Dim arr, y, n, brr
   
4.      arr = Application.Transpose(Sheet2.Range("a2:a16"))
   
5.   
   
6.     'ReDim brr(1 To WorksheetFunction.RoundUp(UBound(arr) / 3, 0) * 10 - 9, 1 To 7)
   
7.     brr = Range("b2:h100")
   
8.      n = 1
   
9.      k = -2
   
10.      For y = 1 To UBound(arr)
    
11.          k = k + 3
    
12.          If k > 7 Then k = 1: n = n + 10
    
13.          brr(n, k) = arr(y)
    
14.      Next y
    
15.      Range("b2").Resize(n, 7) = brr
    
16. 
    
17. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2. 
   
3.     Dim arr, y, n, brr
   
4.      arr = Application.Transpose(Sheet2.Range("a2:a16"))
   
5.   
   
6.     'ReDim brr(1 To WorksheetFunction.RoundUp(UBound(arr) / 3, 0) * 10 - 9, 1 To 7)
   
7.     brr = Range("b2:h100")
   
8.      n = 1
   
9.      k = -2
   
10.      For y = 1 To UBound(arr)
    
11.          k = k + 3
    
12.          If k > 7 Then k = 1: n = n + 10
    
13.          brr(n, k) = arr(y)
    
14.      Next y
    
15.      Range("b2").Resize(n, 7) = brr
    
16. 
    
17. End Sub
    

复制代码

markang

谢谢,完美