vba 如何根据多个条件获取行？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23550582/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to get row based on multiple criteria?
提问by sigil
I'm trying to search a worksheet for a row where the values in the first 3 columns match a set of 3 criteria. I'm using this linear search:
我正在尝试在工作表中搜索前 3 列中的值与一组 3 个条件匹配的行。我正在使用这个线性搜索：
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
We can assume that for any 3 criteria, there is only one match. However, this is very slow. dSheethas ~35,000 entries to search through, and I need to perform ~400,000 searches.
我们可以假设对于任何 3 个标准，只有一个匹配项。然而，这是非常缓慢的。 dSheet有大约 35,000 个条目要搜索，我需要执行大约 400,000 次搜索。
I looked at some of the solutions in this question, and while I'm sure that using AutoFilter or an advanced would be faster than a linear search, I don't understand how to get the index of the row that the filter returns. What I'm looking for would be:
我查看了这个问题中的一些解决方案，虽然我确信使用 AutoFilter 或高级搜索会比线性搜索更快，但我不明白如何获取过滤器返回的行的索引。我正在寻找的是：
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
How do I actually return the resultrow that I'm looking for once I've applied AutoFilter?
result一旦我应用了自动筛选，我如何实际返回我正在寻找的行？
采纳答案by Tim Williams
For performance you're hard-pressed to beat a Dictionary-based lookup table:
为了性能，您很难击败基于字典的查找表：
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
回答by Bjoern Stiel
If you want to do an exact lookup on 3 columns, you can use VLOOKUP using a slight trick: you create a key based on your 3 columns. E.g. if you want to perform your query on columns B, C, D, create a key column in A based on your three columns (e.g. =B1&C1&D1). Then:
如果您想对 3 列进行精确查找，您可以使用 VLOOKUP 使用一个小技巧：根据您的 3 列创建一个键。例如，如果您想对 B、C、D 列执行查询，请根据您的三列（例如 =B1&C1&D1）在 A 中创建一个键列。然后：
=VLOOKUP(lookupvalue1&lookupvalue2&lookupvalue3,A:D,{2,3,4},FALSE)
should do the magic.
应该做的魔术。
回答by dee
One simple solution could be using excel function MATCH as array formula. No for-each loops so I guess this could run very fast.
一种简单的解决方案是使用 excel 函数 MATCH 作为数组公式。 没有 for-each 循环，所以我想这可以运行得非常快。
Formula will look e.g. like this MATCH("A"&"B"&"C",RANGE_1&RANGE_2&RANGE_3,0)
公式看起来像这样 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
Output: A,B,C was found on row : [4]
输出：A、B、C 被发现在行：[4]
回答by Salah Gounaya
In order to improve the best answer (multi criteria search), you would want to check for duplicates to avoid error.
为了改进最佳答案（多条件搜索），您需要检查重复项以避免错误。
'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
