关于将range对象赋值给数组

zhulx_wx

kuaile5935 发表于 2015-8-6 16:45
在立即窗口中输入一行代码，之后按回车

比如，输入 msgbox Worksheets(1).Cells(Rows.Count, 1).End(x ...

好的,谢谢!

lbpp

标题“关于将range对象赋值给数组”的说法与楼主实际问题是有出入的，其实按楼主的方法只是把range对象的value赋值给了数组，而不是把range对象赋值给了数组。

ning84

Range复制到数组的应用。

1. Sub M()
   
2.    Dim Sht As Worksheet, Rng As Range
   
3.    Dim Rr, Rrr, Cc, Ccc
   
4.    Dim Arr
   
5.    Dim ii, jj, jj1
   
6.       'Arr = Array("兰州", "珠海", "武汉", "北京", "抚远", "漠河", "三沙", "喀什")
   
7.       'Arr = rArr(Array("兰州", "珠海", "武汉", "北京", "抚远", "漠河", "三沙", "喀什"))
   
8.       Set Sht = Sheet1
   
9.       Set Rng = Sht.Range("B1:I1")
   
10.       Cc = 1
    
11.       Rrr = 20
    
12.       Arr = RngToArr(Sht.Range("B1:I1"))
    
13. 
    
14.       ''
    
15.       For ii = 0 To UBound(Arr)
    
16.           For jj = 0 To UBound(Arr)
    
17.                Sht.Cells(Rrr + ii, jj + 2) = Arr(ii, jj)
    
18.           Next jj
    
19.       Next ii
    
20. End Sub
    
21. 
    
22. Function RngToArr(Rng As Range)
    
23.    Dim Rr
    
24.       Rr = Rng.Columns.Count
    
25.       ReDim Arr(Rr - 1, Rr - 1)
    
26.       
    
27.       For jj = 1 To Rng.Columns.Count
    
28.           Cc = 0
    
29.           For jj1 = jj To Rng.Columns.Count
    
30.                'Sht.Cells(Rr + jj, Cc + JJ1) = Rng(, cC)
    
31.                Set Arr(jj - 1, Cc) = Rng(, jj1)
    
32.                Cc = Cc + 1
    
33.           Next jj1
    
34.           For jj1 = 1 To jj - 1
    
35.                'Sht.Cells(Rr + jj, Cc + JJ1) = Rng(, cC)
    
36.                Set Arr(jj - 1, Cc) = Rng(, jj1)
    
37.                Cc = Cc + 1
    
38.           Next jj1
    
39.       Next jj
    
40.       RngToArr = Arr
    
41. End Function

复制代码