数组写单元格的问题

金子

1. 
   
2. Sub t()
   
3.     Dim arr, i%, j%
   
4.     arr = Sheet1.Range("A2", Sheet1.Range("D65536").End(xlUp))
   
5.     For i = 1 To UBound(arr)
   
6.         If arr(i, 4) - Date <= 0 Then
   
7.             Debug.Print i
   
8.             '数据量大的情况下，下面一行代码每次都写单元格影响速度，如何将它记在另一数组中，然后一次性回写单元格
   
9.         Cells(i + 1, 5) = arr(i, 1) & " 借款已于 " & arr(i, 4) & " 到期"
   
10. 'brr=
    
11.         End If
    
12.     Next
    
13. End Sub
    

复制代码

数组写单元格的问题.rar (14.17 KB, 下载次数: 21)

2012-4-29 10:21 上传

点击文件名下载附件

swl4561255

参见附件。

wj2368

.............................

金子

数组写单元格的问题2.rar (16.36 KB, 下载次数: 20)

2012-5-1 11:35 上传

点击文件名下载附件

'快的代码

1. 
   
2. Sub WhetherExpire_1()
   
3.     Dim arr, FinalRow As Long, t As Single, i As Long
   
4.    
   
5.     t = Timer
   
6. AutoFillExample
   
7.     FinalRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
   
8.     Sheets("Sheet1").Range("E2:E" & FinalRow).ClearContents
   
9.     arr = Sheet1.Range("A2", "D" & FinalRow)
   
10.    
    
11.     For i = 1 To UBound(arr)
    
12.         If arr(i, 4) - Date <= 0 Then
    
13. '            Debug.Print i
    
14.             '数据量大的情况下，下面一行代码每次都写单元格影响速度，如何将它记在另一数组中，然后一次性回写单元格
    
15.             Cells(i + 1, 5) = arr(i, 1) & " 借款已于 " & arr(i, 4) & " 到期"
    
16.         End If
    
17.     Next
    
18.    
    
19.     Cells(1, 7) = Timer - t
    
20. End Sub

复制代码

为何下面的代码反到更慢？

1. 
   
2. Sub WhetherExpire_3()
   
3.     Dim arr, brr(), FinalRow As Long, t As Single, i As Long
   
4.     t = Timer
   
5. AutoFillExample
   
6.     With Sheets("Sheet1")
   
7.         FinalRow = .Range("A" & Rows.Count).End(xlUp).Row
   
8.         .Range("E2:E" & FinalRow).ClearContents
   
9.         arr = .Range("A2", "D" & FinalRow)
   
10. 
    
11.         For i = 1 To UBound(arr)
    
12.             ReDim Preserve brr(1 To i)
    
13.             If arr(i, 4) - Date <= 0 Then
    
14.                 brr(i) = arr(i, 1) & " 借款已于 " & arr(i, 4) & " 到期"
    
15.             End If
    
16.         Next
    
17. 
    
18.         .[E2].Resize(UBound(brr), 1) = Application.Transpose(brr)
    
19.         .Cells(1, 6) = Timer - t
    
20.     End With
    
21. End Sub

复制代码