在VBA中获得命名范围的Excel单元格的更快捷的方法

我有一个大范围的单元格(超过600),每个都有一个名字分配。 整个工作表有近3000个命名范围。 我build立了一个这样的数组,所以我可以评估每个规则集复制到汇总表。 代码的其余部分足够快,但这部分速度要慢得多。

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

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秒。 我已经testing了评论慢行。 这部分只需要0.2。

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

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

你有没有尝试过使用

 Range("A1").ListNames 

要么

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

您可以通过编写自己的优化查找来提高性能。 我创build了一个粗糙的方法,比x100的performance还要好。

一般方法:

  • 加载所有命名的范围和地址列表(我使用了一个数组)。 在代码的开始处执行一次
  • 编写一个优化的searchfunction来查找数据中的指定地址(数组)
  • 在你的主循环中build立地址,并使用你的searchfunction获取名称

我试过的searchfunction是相当简单的:一个简单的顺序search,但是从find姓的索引处开始。 如果名称大致sorting,这可能是相当优化的。 YMMV特别是如果你的名字没有图案(在这种情况下,二进制search会更好)

我包括我的testing代码以供参考。 它需要工作才能成为生产代码

 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毫秒vs 23,805毫秒(即50 x 600查找)