我有这个代码用于查找给定标题的列字母:
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
,这已经加速了事情就够了。
答案 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