2016-03-03 84 views
1

我有一个大范围的单元格(600多个),每个单元格都分配了一个名称。整个工作表有近3000个命名范围。我建立了一组这样的数组,这样我就可以评估每组规则并将其复制到汇总表中。其余的代码速度足够快,但这部分速度要慢得多。在VBA中获得命名范围的Excel单元格的更快方法

我的代码来获取名称基本上是:

s = Timer 
Debug.Print x & ": " & Timer - s & " seconds": x = x + 1 
For intIndex = 1 To rngQuestions.Rows.Count 
    astrNames(intIndex - 1, 0) = rngQuestions.Cells(intIndex, 1).Name.Name ' THIS IS SLOW 
    astrNames(intIndex - 1, 1) = rngQuestions.Cells(intIndex, 1).Address 
Next 
Debug.Print x & ": " & Timer - s & " seconds": x = x + 1 

这是接管1.5秒。我已经测试评论慢行。这部分只需要0.2。

是否有另一种方法来获得这样的大范围的名称?

我已经测试过构建一个单独的字典或数组名称,并在我的循环中调用,但字典没有改进,数组实际上有时较慢。下面是使用这些方法的代码示例:https://gist.github.com/snoopen/e6fd0d72a88b2179cf7a

+0

'rngQuestions.Name.Name'正在评估一遍又一遍:它会一直返回相同的值,所以只需要做一次。 –

+1

对不起,我简化了我的代码,忘了离开Cell()位。问题已更新。 – snoopen

回答

0

您是否尝试过使用

Range("A1").ListNames 

或者

for each n in thisworkbook.names 
    debug.print n.name & " - " & n.RefersTo 
next n 
+0

我已经更新了我的问题,提及我总共有3000个命名范围,而我只对我的范围内的600个范围感兴趣。我试过修改你的第二个建议,我在那里建立,然后搜索一个数组或名称的字典,但它最终只需要花费很长时间。 – snoopen

0

可以提高对性能通过编写自己的优化的查找。我创建了一个粗糙的方法,比x100的性能更好。

一般方法:

  • 加载所有命名范围和地址到存储器中的列表(I使用阵列)。在你的代码开始执行一次该
  • 写一个优化的搜索功能来查找数据(数组)在指定的地址
  • 在主循环建立的地址,并使用搜索功能来获取名称

我试过的搜索功能很粗糙:一个简单的顺序搜索,但是从找到姓的索引开始。如果名称大致排序,这可能是最佳的。 YMMV尤其是如果你的名字没有图案(在这种情况下,二进制搜索会更好)

我包含了我的测试代码以供参考。它需要的工作,成为生产代码

Option Explicit 
Public Declare Function GetTickCount Lib "kernel32"() As Long 

Sub z() 
    Range("H1").ListNames 
End Sub 


Sub Demo() 
    Dim t1 As Long, t2 As Long 
    Dim vAddr As Variant, vName As Variant 
    Dim addr As String, Nm As String 
    Dim n As Long 

    ' Names stored on sheet for conveniance 
    ' These lists created with .ListNames 
    vAddr = Range("I1:I3172").Value2 ' Names stored here 
    vName = Range("H1:H3172").Value2 ' Address stored here 

    Dim i As Long, j As Long 

    t1 = GetTickCount 
    For j = 1 To 10 ' loop for test purposes 
    For i = 5 To 605 ' find 600 names 
     addr = "=Sheet1!$C$" & i 
     n = FindAddr(vAddr, addr) 
     Nm = vName(n, 1) 
    Next 
    Next 
    t2 = GetTickCount 
    Debug.Print t2 - t1 


    t1 = GetTickCount 
    For j = 1 To 10 
    For i = 5 To 605 
     Nm = Cells(i, 3).Name.Name 
    Next 
    Next 
    t2 = GetTickCount 
    Debug.Print t2 - t1 
End Sub 

Function FindAddr(dat As Variant, item As String) As Long 
    Dim i As Long 
    Dim fnd As Boolean 
    Static init As Long 

    If init = 0 Then init = 1 
    For i = init To UBound(dat, 1) 
     If dat(i, 1) = item Then 
      fnd = True 
      Exit For 
     End If 
    Next 
    If Not fnd Then 
    For i = 1 To init - 1 
     If dat(i, 1) = item Then 
      fnd = True 
      Exit For 
     End If 
    Next 
    End If 
    init = i 
    FindAddr = i 
End Function 

在我的硬件结果109 ms和23805毫秒(这是为50×600查询)