Excel VBA 中用数组的例子

Sub dd()

Dim dic As Object

Dim i As Integer, j As Integer, k As Integer, t As Double

Set dic = CreateObject("scripting.dictionary")

' Timer 记录花费的时间

t = Timer

' 把Sheet1中所有有数据的行加入到字典当中

For i = 1 To Sheets("sheet1").[a65536].End(xlUp).Row

   dic.Add Sheets("sheet1").Cells(i, 1).Value, Sheets("sheet1").Cells(i, 2).Value

   Next

With Sheets("sheet3")

' 搜索Sheet3中所有有数据的行

For j = 2 To .[d65536].End(xlUp).Row

 

      If .Cells(j, 1).Value <> "" Then

      k = j

      l = .Cells(j, 1).Value

      .Cells(j, 9).Value = dic(l) / 100 * .Cells(j, 5).Value

      End If

     

      If .Cells(j, 1).Value = "" Then

     

      .Cells(j, 9).Value = dic(l) / 100 * Sheets("sheet3").Cells(j, 5).Value

      End If

     

      If Sheets("sheet3").Cells(j, 4) = "" Then

             

      .Cells(j, 9).Formula = "=sum(R[-1]c:r[-" & j - k & "]c)"

      .Cells(j, 9).Interior.ColorIndex = 38

     

      End If

     

  Next

End With

MsgBox Timer - t

End Sub

Sub ff()

Dim dic As Object

Dim i As Integer, j As Integer, k As Integer, t As Double

Set dic = CreateObject("scripting.dictionary")

' Timer 记录花费的时间

t = Timer

' 把Sheet1中所有有数据的行加入到字典当中

For i = 1 To Sheets("sheet1").[a65536].End(xlUp).Row

   dic.Add Sheets("sheet1").Cells(i, 1).Value, Sheets("sheet1").Cells(i, 2).Value

   Next

With Sheets("sheet3")

' 搜索Sheet3中所有有数据的行最大行号

pp = .[d65536].End(xlUp).Row

Dim arr

' 把i2列中有效数据列生成一个临时数组

arr = .[i2].Resize(pp - 1, 1)

For j = 2 To pp

   

      If .Cells(j, 1).Value <> "" Then

      k = j

      l = .Cells(j, 1).Value

      arr(j - 1, 1) = dic(l) / 100 * .Cells(j, 5).Value

      End If

     

      If .Cells(j, 1).Value = "" Then

     

      arr(j - 1, 1) = dic(l) / 100 * Sheets("sheet3").Cells(j, 5).Value

      End If

     

      If Sheets("sheet3").Cells(j, 4) = "" Then

      For l = k - 1 To j - 2

      arr(j - 1, 1) = arr(l, 1) + arr(j - 1, 1)

      Next l

      .Cells(j, 9).Interior.ColorIndex = 38

     

      End If

     

  Next

  ' 一次性把数组所有数据赋值给 i2 列

  .[i2].Resize(pp - 1, 1) = arr

End With

MsgBox Timer - t

End Sub