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

爱疯

目的：为所选区域的每一个单元格赋值，内容为其地址。

Sub aa()
    Dim x As Range

    For Each x In Selection
        x = x.Address
    Next x
End Sub

这样算满足要求了，但速度很慢。请问：有办法提速么？谢谢！

[此贴子已经被作者于2010-8-25 21:08:26编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-8-25 11:33

又快了一点，编写了一个改写地址的函数

Sub aa()
    Dim Rng As Range
    Dim ArrTemp() As String
    Dim RowN&, ColN&
    Application.ScreenUpdating = False
    t = Timer
    For Each Rng In Selection.AreaS
        RowN = Rng.Rows.Count
        ColN = Rng.Columns.Count
        ReDim ArrTemp(1 To RowN, 1 To ColN) As String
        With Rng
            For i = 1 To RowN
                ArrTemp(i, 1) = .Item(i, 1).Address
                For j = 2 To ColN
                    ArrTemp(i, j) = MyAdd(ArrTemp(i, j - 1))
                Next j
            Next i
            .Value = ArrTemp
        End With
    Next Rng
    MsgBox Timer - t
    Application.ScreenUpdating = True
End Sub
Function MyAdd(Add)
    Dim Arr() As String
    Dim strC$
    Dim Temp$
    Dim BlnJW As Boolean
    Arr = Split(Add, "$")
    strC$ = Arr(1)
    BlnJW = True
    For i = Len(strC$) To 1 Step -1
        Temp$ = Mid$(strC$, i, 1)
        If BlnJW Then
            If Temp$ = "Z" Then
                Mid$(strC$, i, 1) = "A"
                BlnJW = True
            Else
                Mid$(strC$, i, 1) = Chr(Asc(Temp$) + 1)
                BlnJW = False
            End If
        End If
    Next i
    If BlnJW Then strC$ = "A" & strC$
    MyAdd = "$" & strC & "$" & Arr(2)
End Function

跳转到最佳答案楼层

amulee

区域不大的话这个已经很快了

Sub aa()
    Dim x As Range
    Application.ScreenUpdating = False
    For Each x In Selection
        x = x.Address
    Next x
    Application.ScreenUpdating = True
End Sub

Dj_soo

用数组就好了,其实这里影响速度的不是循环,而是每次对x的写的操作.

对大量的单元格进行写操作影响了速度,所以用数组一次赋值肯定可以提速了

amulee

又改良了一下，这个更快

Sub aa()
    Dim Rng As Range
    Dim ArrTemp
    Dim RowN&, ColN&
    Application.ScreenUpdating = False
    For Each Rng In Selection.Areas
        RowN = Rng.Rows.Count
        ColN = Rng.Columns.Count
        ReDim ArrTemp(1 To RowN, 1 To ColN)
        For i = 1 To RowN
            For j = 1 To ColN
                ArrTemp(i, j) = Rng(i, j).Address
            Next j
        Next i
        Rng = ArrTemp
    Next Rng
    Application.ScreenUpdating = True
End Sub

爱疯

谢谢阿木！

问这例子的目的，还是和前面的问题有关。

   Dim myArray
   myArray = Selection.Address

幻想这样后，便把区域里各单元格的地址赋给数组myArray，就象当初myArray = Selection，把区域里各个单元格的值赋给数组myArray。但 ...... 这绝对是错误的[em22]

考虑总会有意想不到的好事，所以来问。一定不存在捷径吗？当然如果能证明，也是正确的答案。

Dj_soo

Sub Button1_Click()
    Dim arr As Variant
    Dim Ads As Variant
    Dim AreaS As Range
    Dim AddStr As String
    Dim arrRes() As String
    Dim Ro As Long
    Dim Col As Byte
    With Selection
        AddStr = .Address
        arr = Split(AddStr, ",")
        For Each Ads In arr
            Set AreaS = Range(Ads)
            ReDim arrRes(1 To AreaS.Rows.Count, 1 To AreaS.Columns.Count)
            For Ro = 1 To AreaS.Rows.Count
                For Col = 1 To AreaS.Columns.Count
                    arrRes(Ro, Col) = AreaS.Cells(Ro, Col).Address
                Next Col
            Next Ro
            AreaS = arrRes
        Next Ads
    End With
End Sub

写的比阿木的麻烦了些,学习一下

amulee

又加快了一点，DJ那个选取整行、整列就有错误

Sub aa()
    Dim Rng As Range
    Dim ArrTemp
    Dim RowN&, ColN&
    Application.ScreenUpdating = False
    For Each Rng In Selection.AreaS
        RowN = Rng.Rows.Count
        ColN = Rng.Columns.Count
        ReDim ArrTemp(1 To RowN, 1 To ColN)
        With Rng
            For i = 1 To RowN
                For j = 1 To ColN
                    ArrTemp(i, j) = .Item(i, j).Address
                Next j
            Next i
            .Value = ArrTemp
        End With
    Next Rng
    Application.ScreenUpdating = True
End Sub

Dj_soo

嗯,之前没怎么用过.areas,都忘掉了

Dj_soo

Application.ScreenUpdating = False
一般上面一句的提速是针对Excel单元格的读写的,如果读写不是很多可以不用加上这句.(个人理解)

爱疯

原来1楼是遍历赋值。现在dj和阿木的，较1楼更快的原理，用语言描述该怎么说呀？

[em11]