Question

我有大量的单元格（超过600个），每个单元格都指定了一个名称。整个工作表有近3000个命名范围。我正在构建这些数组，以便我可以根据一组规则对每个规则进行评估，以便将其复制到摘要表中。其余的代码足够快，但这部分要慢得多。

获取名称的代码基本上是：

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。

还有另一种方法可以获得像这样大范围的名称吗？

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

Answer 1

您是否尝试过使用

Range("A1").ListNames

或者

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

Answer 2

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

一般方法：

将所有命名范围和地址的列表加载到内存中（我使用了数组）。在代码开头执行此操作
编写优化的搜索功能以在数据（数组）
在主循环中构建地址并使用搜索功能获取名称

我尝试的搜索功能非常粗糙：一个简单的顺序搜索，但是从找到姓氏的索引开始。如果名称大致排序，这可能是非常理想的。 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毫秒vs 23,805毫秒（这是50 x 600查询）

更快地获取VBA中命名范围的Excel单元格

2 个答案: