Excel VBA:find头的列字母的更快方法?

我有这个代码来查找给定头的列字母:

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) /只是第一行( in_cells.Range("1:1) ),并将xlByRows更改为xlByColumns ,这已足够的速度。

对于什么是值得的,这里是一个非常快速的function,可以在不调用Find情况下做你想做的事情。 根据我的(很古老的)笔记,它来自这里 。 参数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 

编辑 :鉴于澄清在评论中,这里是一个testing设置。发现vs .Match ,似乎更快。 使用数组的variables值可能会更快 ,但我会留在这里。

设置第一行数据:

 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 

原始函数(加上error handling找不到的值)以及调用上述函数的匹配版本:

 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 

(非常粗糙的)testing方法(下面的一些参数说明):

 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是否看到debugging输出,并printEvery检查该输出的次数。

我的结果,为1000testing,但没有结果debugging输出:

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