他山之石——VBA数组的使用-Part1（VBA Array）

数据量较大时，数组的使用几乎是必不可少的。所以，数组必须熟练。

Option Explicit

'向VBA数组中写入数据
   
   '1、按编号（标）写入和读取
   
     Sub t1() '写入一维数组
     Dim x As Integer
     Dim arr(1 To 10)
   arr(2) = 190
   arr(10) = 5
     End Sub
  
    Sub t2() '向二维数组写入数据和读取
     Dim x As Integer, y As Integer
     Dim arr(1 To 5, 1 To 4)
     For x = 1 To 5
       For y = 1 To 4
         arr(x, y) = Cells(x, y)
       Next y
     Next x
    MsgBox arr(3, 1)
    End Sub
    
   '2、动态数组
       Sub t3()
        Dim arr()
        Dim row
        row = Sheets("sheet2").Range("a65536").End(xlUp).row - 1
        ReDim arr(1 To row)
        For x = 1 To row
           arr(x) = Cells(x, 1)
        Next x
        Stop
       End Sub
       
   '3、批量写入
    
      Sub t4() '由常量数组导入
      Dim arr
      arr = Array(1, 2, 3, "a")
      Stop
      End Sub
    
     Sub t5() 'Óɵ¥Ôª¸ñÇøÓòµ¼Èë
       Dim arr
       arr = Range("a1:d5")
       Stop
     End Sub


Option Explicit

'VBA数组
  '1、在内存中读取
      
       '在内存中读取后用于继续运算，直接用下面的格式
        
        '数组变量(5)
        '数组变量(3,2)
     '例:
        Sub d1()
         Dim arr, arr1()
         Dim x As Integer, k As Integer, m As Integer
         arr = Range("a1:a10") '把单元格区域导入内存数组中
         m = Application.CountIf(Range("a1:a10"), ">10") '计算大于10的个数
         ReDim arr1(1 To m)
         For x = 1 To 10
           If arr(x, 1) > 10 Then
              k = k + 1
              arr1(k) = arr(x, 1)
              MsgBox arr1(k)
           End If
           
         Next x
         Stop
         
        End Sub
        
        
  '2、读取存入单元格中
          
      Sub d2() '二维数组存入单元格
        Dim arr, arr1(1 To 5, 1 To 1)
        Dim x As Integer
        arr = Range("b2:c6")
        For x = 1 To 5
          arr1(x, 1) = arr(x, 1) * arr(x, 2)
        Next x
        Range("d2").Resize(10) = arr1
      End Sub
      Sub vl()
         Dim arr, arr1
         Dim x, k As Integer
         Dim tt As Long
         Application.ScreenUpdating = False
                arr = Range("I2:J1433")
                arr1 = Range("f2:g1433")
                    For x = 1 To 1432
                                For k = 1 To 1432
                                    If arr(k, 1) = arr1(x, 1) Then
                                        arr1(x, 2) = arr(k, 2)
                                        Exit For
                                    End If
                                   Range("g2").Resize(1432) = arr1(x, 2)
                        Next k
                    Next x
                    Application.ScreenUpdating = True
      End Sub
      
      Sub d3() '一维数组存入单元格
        Dim arr, arr1(1 To 5)
        Dim x As Integer
        arr = Range("b2:c6")
        For x = 1 To 5
          arr1(x) = arr(x, 1) * arr(x, 2)
        Next x
        'Range("a13").Resize(1, 5) = arr1
        Range("d2").Resize(5) = Application.Transpose(arr1)
      End Sub
       
      Sub d4() '数组部分存入
        Dim arr, arr1(1 To 10000, 1 To 1)
        Dim x As Integer
        arr = Range("b2:c6")
        For x = 1 To 5
          arr1(x, 1) = arr(x, 1) * arr(x, 2)
        Next x
        Range("d2").Resize(5) = arr1
      End Sub