[已解决]单元格赋值提速

amulee

QUOTE:

以下是引用爱疯在2010-8-26 8:34:00的发言：

通过学习大家的方法，觉得阿木的方法还能优化。 

上图是DJ，下图是阿木。22楼的读取次数没具体描述，可能产生误解，如图应该没错吧？

还是比如测试范围是a1:d20000。只要读取了：

• Rng.item(1,1)   '区域中第1个单元格
• Rng.Rows.Count   '区域所用行
• Rng.Columns.Count   '区域所用列

剩下的数组元素的值，就都可以从前1个数组元素计算出来了。形如下图：

 

        Dim x As Range
        ArrTemp(1, 1) = Rng.Item(1, 1).Address
        For
   Each x In Rng
            s = s + 1
            If s = RowN * ColN Then
                ArrTemp(i, j) = MyAdd()
            End
   If
        Next x

好像这样，myadd的方法需要另改。不知道这样想，对不对？

没错。原来也是准备读取每个区域第一个单元格地址然后递推，但是觉得有些烦了，就只写了读取每行第一个单元格地址的递推函数。

这个函数还可以优化，只要读取区域中的第一个单元格地址即可。

其实数组的读取也耗时间，也可以想办法省略掉，让MyAdd写成传地址的方式，每次就按照单元格顺序直接改变其中的参数变量，或者将这个函数合并到过程中可能更容易理解。

爱疯

15楼myadd我的理解感觉就不适应，再变复杂就更 ....了[em22]

过儿

完善了一下：

Dim arr2(1 To 256)
Sub dd()
 Dim t
 Dim arr
 Dim rg As Range
 t = Timer
 Call re
 Selection = ""
 For Each rg In Selection.Areas
 rc = rg.Rows.Count
 cc = rg.Columns.Count
 r = rg.Row
 c = rg.Column
 ReDim arr1(1 To r + rc - 1, 1 To c + cc - 1)
 For x = 1 To rc
   For y = 1 To cc
      arr1(x, y) = arr2(c + y - 1) & x + r - 1
   Next y
 Next x
 rg = arr1
 Erase arr1
Next rg
 MsgBox Timer - t
End Sub

Sub re()
Dim arr, arr1
arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
arr1 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
  For x = 1 To 26
    arr2(x) = arr(x - 1)
  Next x
  For x = 0 To 8
    For y = 0 To 25
      k = k + 1
      If 26 + k > 256 Then Exit For
      arr2(26 + k) = arr1(x) & arr(y)
    Next y
  Next x
End Sub

兰色幻想

修正了大于Z列的情况

修正了只能选单个区域的情况

Dim arr2(1 To 256)
Sub dd()
 Dim t
 Dim arr
 Dim rg As Range
 t = Timer
 Call re
 Selection = ""
 For Each rg In Selection.Areas
 rc = rg.Rows.Count
 cc = rg.Columns.Count
 r = rg.Row
 c = rg.Column
 ReDim arr1(1 To r + rc - 1, 1 To c + cc - 1)
 For x = 1 To rc
   For y = 1 To cc
      arr1(x, y) = arr2(c + y - 1) & x + r - 1
   Next y
 Next x
 rg = arr1
 Erase arr1
Next rg
 MsgBox Timer - t
End Sub

Sub re()
Dim arr, arr1
arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
arr1 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
  For x = 1 To 26
    arr2(x) = arr(x - 1)
  Next x
  For x = 0 To 8
    For y = 0 To 25
      k = k + 1
      If 26 + k > 256 Then Exit For
      arr2(26 + k) = arr1(x) & arr(y)
    Next y
  Next x
End Sub

爱疯

前面我们讨论速度时，好像都陷入以汽车为条件的前提下，没想到兰版自己悄悄铺铁轨[em03]......

花了不少力"准备"，不知是否因此，自定义函数名才叫re（ready的缩写）

 

[em01][em01]

吕?布

把它改为字体颜色好玩一点

吕?布

把它改为背景颜色好玩一点。

兰色幻想

QUOTE:

以下是引用吕?布在2010-8-26 10:31:00的发言：
把它改为背景颜色好玩一点。

用背景色？用背景色就不用判断了吧，循环也省了

[此贴子已经被作者于2010-8-26 10:37:15编辑过]

兰色幻想

就是对特殊单元格填充，也是一样先生成地址，然后再批量填充填色

爱疯

7、尽量用地址方式传递变量的值

请问阿木，20楼这句的“地址方式”是什么意思，有过例子么？