如何根据多个条件获取行？
我试图search工作表的前3列中的值匹配一组3条件的行。 我正在使用这个线性search：
Function findRow(pName as string,fNo as string,mType as string) As Long Dim rowCtr As Long rowCtr = 2 While Not rowMatchesCriteria(rowCtr, pName,fNo,mType) rowCtr = rowCtr + 1 Wend findRow=rowCtr End Function Function rowMatchesCriteria(row As Long, pName As String, fNo As String, mType As String) As Boolean rowMatchesCriteria = dSheet.Cells(row,1)=pName _ And dSheet.Cells(row,2)=fNo _ And dSheet.Cells(row,3)=mType End Function 我们可以假设任何3个标准，只有一个匹配。 但是，这是非常缓慢的。 dSheet有35,000个条目可供search，我需要执行dSheet条search。
我看了一些在这个问题的解决scheme，虽然我确定使用AutoFilter或高级会比线性search更快，但我不明白如何获得filter返回的行的索引。 我正在寻找的是：
Sub makeUpdate(c1 as string,c2 as string,c3 as string) Dim result as long result = findRow(c1,c2,c3) dSheet.Cells(result,updateColumn) = someUpdateValue End Sub
一旦我应用了AutoFilter，我该如何返回result行？
为了performance，你很难击败一个基于字典的查找表：
Sub FindMatches() Dim d As Object, rw As Range, k, t Dim arr, arrOut, nR, n t = Timer 'create the row map (40k rows) Set d = GetRowLookup(Sheets("Sheet1").Range("A2:C40001")) Debug.Print Timer - t, "map" t = Timer 'run lookups on the row map '(same values I used to create the map, but randomly-sorted) For Each rw In Sheets("sheet2").Range("A2:C480000").Rows k = GetKey(rw) If d.exists(k) Then rw.Cells(3).Offset(0, 1).Value = d(k) Next rw Debug.Print Timer - t, "slow version" t = Timer 'run lookups again - faster version arr = Sheets("sheet2").Range("A2:C480000").Value nR = UBound(arr, 1) ReDim arrOut(1 To nR, 1 To 1) For n = 1 To nR k = arr(n, 1) & Chr(0) & arr(n, 2) & Chr(0) & arr(n, 3) If d.exists(k) Then arrOut(n, 1) = d(k) Next n Sheets("sheet2").Range("D2").Resize(nR, 1).Value = arrOut Debug.Print Timer - t, "fast version" End Sub 'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) d.Add k, rw.Cells(1).Row 'not checking for duplicates! Next rw Set GetRowLookup = d End Function 'create a key from a given row Function GetKey(rw As Range) GetKey = rw.Cells(1).Value & Chr(0) & rw.Cells(2).Value & _ Chr(0) & rw.Cells(3).Value End Function
如果你想对3列进行精确的查找，你可以使用VLOOKUP使用一些小技巧：根据你的3列创build一个键。 例如，如果要在列B，C，D上执行查询，请根据您的三列（例如= B1＆C1＆D1）在A中创build一个关键列。 然后：
=VLOOKUP(lookupvalue1&lookupvalue2&lookupvalue3,A:D,{2,3,4},FALSE)
应该做魔术。
一个简单的解决scheme可能是使用Excel函数MATCH作为数组公式 。 没有为每个循环，所以我想这可以运行得非常快。
公式将看起来像这样的MATCH（“A”＆“B”＆“C”，RANGE_1＆RANGE_2＆RANGE_3,0）
Option Explicit Private Const FORMULA_TEMPLATE As String = _ "=MATCH(""CRITERIA_1""&""CRITERIA_2""&""CRITERIA_3"",RANGE_1&RANGE_2&RANGE_3,MATCH_TYPE)" Private Const EXACT_MATCH = 0 Sub test() Dim result result = findRow("A", "B", "C") Debug.Print "A,B,C was found on row : [" & result & "]" End Sub Function findRow(pName As String, fNo As String, mType As String) As Long On Error GoTo Err_Handler Dim originalReferenceStyle originalReferenceStyle = Application.ReferenceStyle Application.ReferenceStyle = xlR1C1 Dim data As Range Set data = ActiveSheet.UsedRange Dim formula As String ' Add criteria formula = Replace(FORMULA_TEMPLATE, "CRITERIA_1", pName) formula = Replace(formula, "CRITERIA_2", fNo) formula = Replace(formula, "CRITERIA_3", mType) ' Add ranges where search formula = Replace(formula, "RANGE_1", data.Columns(1).Address(ReferenceStyle:=xlR1C1)) formula = Replace(formula, "RANGE_2", data.Columns(2).Address(ReferenceStyle:=xlR1C1)) formula = Replace(formula, "RANGE_3", data.Columns(3).Address(ReferenceStyle:=xlR1C1)) ' Add match type formula = Replace(formula, "MATCH_TYPE", EXACT_MATCH) ' Get formula result findRow = Application.Evaluate(formula) Err_Handler: ' Set reference style back Application.ReferenceStyle = originalReferenceStyle End Function
输出：在行上findA，B，C：[4]
为了提高最佳答案（多标准search），你会想检查重复，以避免错误。
'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) if not d.exists(k) then d.Add k, rw.Cells(1).Row 'checking for duplicates! end if Next rw Set GetRowLookup = d End Function