【VBA研究】如何将单元格数据赋给数组

作者：iamlaosong

将工作表中的数据赋给数组或者将数组的数据赋给工作表，一般有两种，一种是循环的方法，一个一个的传，这种方法一般用于需要对每个数据特别处理的场合，另一种是一次性用赋值语句传，就速度来说，第二种方法要快得多。看下面例程：

Sub tt()
    Dim arr1(240000, 4)
    Dim arr2()
    
    lineno = [A1048576].End(xlUp).Row      '行数
    '循环给数组赋值，数组myarr必须先定义大小
    t1 = Now()
    For i = 3 To lineno
        k = i - 2
        arr1(k, 1) = Cells(i, 1)
        arr1(k, 2) = Cells(i, 2)
        arr1(k, 3) = Cells(i, 3)
        arr1(k, 4) = Cells(i, 4)
    Next i
    t2 = Now()
    Cells(2, 5) = TimeValue(t2) - TimeValue(t1)
    '一次性给数组赋值，数组arr不能定义大小和类型
    t1 = Now()
    arr2 = Range("a3:d" & lineno)
    t2 = Now()
    Cells(2, 6) = TimeValue(t2) - TimeValue(t1)
    MsgBox arr1(20000, 2) & "=" & arr2(20000, 2)


End Sub

不过要注意的是，循环赋值的方法数组必须先定义维数和大小，然后才能使用，而一次性赋值的正好相反，不能定义维数和大小，否则会报错。此外注意，数据一次性读入数组arr2后，arr2成为一个二维数组，即使是读取一列数据，也是二维数组，数组下标都是从1开始，即arr2(1,1)，arr2(2,1)，arr2(3,1)，arr2(4,1)，。。。

还有一点要注意，当读取的工作表非当前工作表时，range对象后面需要加上value关键字，否则会报错，例如：

    '方法一：直接读取
    DaiLiNo = Sheets("代理点").[B65536].End(xlUp).Row           '行数
    DaiLiName = Sheets("代理点").Range("B2:B" & DaiLiNo).Value
    '方法二：激活工作表后读取
    Worksheets("代理点").Select
    DaiLiNo = [B65536].End(xlUp).Row           '行数
    DaiLiName = Range("B2:B" & DaiLiNo)
    DaiLiNo = DaiLiNo - 1                      '数据从第2行开始，所以总数量要减一

如果赋值范围用行列号表示，则用下列语句（pos_fst, pos_ems是两个参数，分别是数据起始行和数据所在列）：

maxrow = Cells(65536, pos_ems).End(xlUp).Row

Mail = Range(Cells(pos_fst, pos_ems), Cells(maxrow, pos_ems))

用上面的例程测试发现，即使20多万条数据，第一种方法用时很少（4.62963E-05），而第二种方法却几乎不用时间（0）。

注意：Range(Cells(pos_fst, pos_ems), Cells(maxrow, pos_ems))这种表示方法只适合当前工作表，如果非当前工作表，在前面加上sheets的限定后，就会报错，但sheets(1).range("a1:a10")这种表示方法没有问题。

下面给一个根据安徽区县和所有省区县两张表形成一个安徽出口到各省区县的点到点矩阵表例程：

Sub set_matrix()
'
    Dim sarr1(), sarr2()
    Dim mrow1, mrow2, i, j, k As Integer
    
    '从第3行开始读
    mrow1 = Sheets("安徽").[A65536].End(xlUp).Row
    sarr1 = Sheets("安徽").Range("B3:D" & mrow1).Value
    mrow2 = Sheets("全国").[A65536].End(xlUp).Row
    sarr2 = Sheets("全国").Range("B3:D" & mrow2).Value
    
    '从第4行开始填
    kk = 4
    For i = 1 To mrow1 - 2
        For j = 1 To mrow2 - 2
            Cells(kk, 1) = kk - 3
            Cells(kk, 2) = sarr1(i, 1)
            Cells(kk, 3) = sarr1(i, 2)
            Cells(kk, 4) = sarr1(i, 3)
            Cells(kk, 5) = sarr2(j, 1)
            Cells(kk, 6) = sarr2(j, 2)
            Cells(kk, 7) = sarr2(j, 3)
            kk = kk + 1
        Next j
        Application.StatusBar = "完成：" & Round(i * 100 / mrow2, 2) & "%"
    Next i
    Application.StatusBar = "完成：100%"
    MsgBox "填写完毕！"
End Sub