Excel VBA:更快地找到标题的列字母?

时间:2014-08-14 18:08:50

标签: excel vba excel-vba

我有这个代码用于查找给定标题的列字母:

Public Function GetColumnLetter(ByRef in_cells As Range, ByVal column_header As String, Optional look_at As Excel.XlLookAt = xlPart) As String
    GetColumnLetter = Split(in_cells.Find(what:=column_header, LookAt:=look_at, SearchOrder:=xlByRows).Address(ColumnAbsolute:=False), "$")(0)
End Function

但似乎有点慢。一些工作表似乎花了几秒钟,似乎它不应该花费超过一秒钟。我必须在许多不同的工作表中为许多不同的列执行此操作。

有更快的方法吗?

编辑:我刚刚创建了一个调用此函数的辅助函数,但只有第一行(in_cells.Range("1:1)),并且还将xlByRows更改为xlByColumns,这已经加速了事情就够了。

1 个答案:

答案 0 :(得分:2)

对于它的价值,这是一个非常快速的功能,可以在不调用Find的情况下完成您想要的操作。根据我(很老)的说明,它来自here。参数c表示相关列的索引,如属性Selection.Column中所示。

Public Function GetColumnLetter(ByVal c As Long) As String

    Dim p As Long

    While c
        p = 1 + (c - 1) Mod 26
        c = (c - p) \ 26
        GetColumnLetter = Chr$(64 + p) & GetColumnLetter
    Wend

End Function

编辑:鉴于评论中的说明,此处是一个用于测试.Find.Match的设置,该设置似乎更快。使用数组might be faster still的变量值,但我会留在这里。

设置第一行数据:

Public Sub MakeUglyFirstRow()
    Dim rng As Excel.Range
    Dim i As Long, p As Long
    Dim strChar As String
    Dim initialLength As Integer

    Set rng = ActiveSheet.Rows(1)
    initialLength = 5
    For i = 1 To rng.Cells.Count
        p = 1 + (i - 1) Mod 26
        strChar = String(initialLength, Chr$(64 + p))
        rng.Cells(i).Value = strChar
        If i Mod 26 = 0 Then initialLength = initialLength + 1
    Next i
End Sub

原始函数(加上未找到值的错误处理),以及调用上述函数的匹配版本:

Public Function GetColumnLetter_ByFind(ByRef in_cells As Range, ByVal column_header As String, Optional look_at As Excel.XlLookAt = xlPart) As String
    Dim rngFound As Excel.Range
    Set rngFound = in_cells.Find(what:=column_header, LookAt:=look_at, SearchOrder:=xlByRows)
    If Not (rngFound Is Nothing) Then
        GetColumnLetter_ByFind = Split(rngFound.Address(ColumnAbsolute:=False), "$")(0)
    End If
End Function

Public Function GetColumnLetter_ByMatch(in_cells As Range, text_to_find As String, Optional look_at As Excel.XlLookAt = XlLookAt.xlPart) As String
On Error Resume Next
    Dim rngFirstRow As Excel.Range
    Dim result As Variant
    Dim col As Long
    Dim r As Long

    Set rngFirstRow = in_cells.Rows(1)
    col = 0

    With Application.WorksheetFunction
        If look_at = xlPart Then
            result = .Match("*" + text_to_find + "*", rngFirstRow, 0)
        Else
            result = .Match(text_to_find, rngFirstRow, 0)
        End If
        If .IsError(result) = False Then
            col = CLng(result) 'will need an offset if the range's first column is not 1
        End If
    End With

    If col > 0 Then
        GetColumnLetter_ByMatch = GetColumnLetter(col)
    End If
End Function

(非常粗略的)测试方法(下面的一些参数说明):

Public Sub Test_ColumnFinding(Optional testString As String = "yyy", _
                              Optional numberOfTests As Long = 1000, _
                              Optional printResults As Boolean = True, _
                              Optional printEvery As Integer = 10)

    Dim rng As Excel.Range
    Dim timStart1 As Single, timEnd1 As Single, timTotal1 As Single
    Dim timStart2 As Single, timEnd2 As Single, timTotal2 As Single
    Dim strTest1 As String, strTest2 As String
    Dim i As Long

    Set rng = ActiveSheet.Rows(1)
    For i = 1 To numberOfTests
        timStart1 = Timer
        strTest1 = GetColumnLetter_ByFind(rng, testString, IIf(i Mod 3 = 0, XlLookAt.xlPart, XlLookAt.xlWhole))
        timEnd1 = Timer
        timTotal1 = timTotal1 + (timEnd1 - timStart1)

        timStart2 = Timer
        strTest2 = GetColumnLetter_ByMatch(rng, testString, IIf(i Mod 3 = 0, XlLookAt.xlPart, XlLookAt.xlWhole))
        timEnd2 = Timer
        timTotal2 = timTotal2 + (timEnd2 - timStart2)
        If printResults Then
            If i Mod printEvery = 0 Then
                Debug.Print i, "GetColumnLetter_ByFind", strTest1, timEnd1 - timStart1
                Debug.Print i, "GetColumnLetter_ByMatch", strTest2, timEnd2 - timStart2
            End If
        End If
    Next i

    Debug.Print "GetColumnLetter_ByFind took " & timTotal1 / numberOfTests & " seconds on avg to execute"
    Debug.Print "GetColumnLetter_ByMatch took " & timTotal2 / numberOfTests & " seconds on avg to execute"

End Sub

其中testString控制距离匹配,numberOfTests重复,printResults是否查看调试输出,printEvery检查输出的频率。

我的结果,1000次测试但没有结果调试输出:

GetColumnLetter_ByFind took 0.003546875 seconds on avg to execute
GetColumnLetter_ByMatch took 0.00134375 seconds on avg to execute