匹配多个标准并返回多个值

时间:2018-02-14 18:11:37

标签: excel vba excel-vba find match

我有两个电子表格(wbwbtemp);两者都有一个用于位置的列和一个用于要素类型的列。在VBA中,我想找到第二个工作表上的所有行,其中两列与第一个工作表中一行上的两列相同,并获得一个列表或由行号/索引组成的范围。 / p>

然后我想使用这个范围从不同的列中提取值并找到其中的最高对象,但我想如果我可以对这个范围进行排序,我可能会这样做。

Dim wb As Workbook
Dim ws As Worksheet
Dim Features() As Variant
Dim Activity() As Variant
Dim Benthic As Variant
Dim wbtemp As Workbook
Dim BenSenFeatures() As Variant
Dim BenSenActivity() As Variant
Dim LR As Long
Dim LC As Long
Dim r As Long
Dim c As Long
Dim WhatToFind1 As Variant
Dim WhatToFind2 As Variant
Dim rngFound1 As Range
Dim rngFound2 As Range
Dim rng1 As Variant
Dim rng2 As Variant
Dim rngFound As Range
Dim iLoop As Long
Dim colFound As Range

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Features = ws.Range("B:C").Value
Activity = ws.Rows(1).Value

Benthic = InputBox("Filename goes here...")
Set wbtemp = Workbooks.Open(Benthic, True, True)

With wbtemp
    BenSenFeatures = .Sheets(1).Range("A:B").Value
    BenSenActivity = .Sheets(1).Rows(1).Value
End With

LR = ws.Range("C" & Rows.Count).End(xlUp).Row
LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column

For r = 3 To LR

    If Not IsEmpty(Features(r, 2)) Then
        If IsInArray(Features(r, 2), BenSenFeatures, 2) Then
        'If WorksheetFunction.Match(Features(r, 2), BenSenFeatures(0, 2), 0) Then   <---I tried to use the arrays originally
            WhatToFind1 = Features(r, 1)
            WhatToFind2 = Features(r, 2)
            Set rngFound1 = wbtemp.Sheets(1).Columns(1).Cells(wbtemp.Sheets(1).Columns(1).Cells.Count)
            Set rngFound2 = wbtemp.Sheets(1).Columns(2).Cells(wbtemp.Sheets(1).Columns(2).Cells.Count)
            For iLoop = 1 To WorksheetFunction.CountIf(wbtemp.Sheets(1).Columns(1), WhatToFind1)
                Set rngFound1 = wbtemp.Sheets(1).Columns(1).Cells.Find(WhatToFind1, After:=rngFound1)
                rng1(iLoop) = rngFound1.Row
            'WorksheetFunction.Index(wbtemp.Sheets(1).Range("A:B").Value,_
               WorksheetFunction.Match(WhatToFind1 & WhatToFind2,_
               wbtemp.Sheets(1).Columns(1) & wbtemp.Sheets(1).Columns(2),_
               0), 1)     <---originally tried to use match to search for the multiple criteria but couldn't find a way to create a list of indices
                Set rngFound2 = wbtemp.Sheets(1).Columns(2).Cells.Find(WhatToFind2, After:=rngFound2)
                rng2(iLoop) = rngFound2.Row
            Next iLoop
            For Each cell In rng1
                If Not Application.CountIf(rng2, cell.Value) = 0 Then
                    rngFound.Cells(Cells(Rows.Count, 1).End(xlUp) + 1) = cell.Value
                End If
            Next

我最初尝试使用.Match来查找多个条件,但我无法弄清楚如何从中创建一系列索引。然后我尝试使用.Find创建两个索引列表,但我无法弄清楚如何使其工作。我一直在

  

类型不匹配

错误。

我意识到这听起来令人困惑,所以如果有任何需要澄清,请告诉我。

2 个答案:

答案 0 :(得分:0)

这样的事情对你有用。为了清楚起见,我试图对代码进行评论。

<div class="area"></div>
<nav class="main-menu">
  <ul>
    <li><a href="http://justinfarrow.com"><i class="fa fa-home fa-2x"></i><span class="nav-text">Dashboard</span></a></li>
    <li class="has-subnav"><a href="#"><i class="fa fa-laptop fa-2x"></i><span class="nav-text">UI Components</span></a></li>
    <li class="has-subnav"><a href="#"><i class="fa fa-list fa-2x"></i><span class="nav-text">Forms</span></a></li>
    <li class="has-subnav"><a href="#"><i class="fa fa-folder-open fa-2x"></i><span class="nav-text">Pages</span></a></li>
    <li><a href="#"><i class="fa fa-bar-chart-o fa-2x"></i><span class="nav-text">Graphs and Statistics</span></a></li>
    <li><a href="#"><i class="fa fa-font fa-2x"></i><span class="nav-text">Typography and Icons</span></a></li>
    <li><a href="#"><i class="fa fa-table fa-2x"></i><span class="nav-text">Tables</span></a></li>
    <li><a href="#"><i class="fa fa-map-marker fa-2x"></i><span class="nav-text">Maps</span></a></li>
    <li><a href="#"><i class="fa fa-info fa-2x"></i><span class="nav-text">Documentation</span></a></li>
  </ul>
  <ul class="logout">
    <li><a href="#"><i class="fa fa-power-off fa-2x"></i><span class="nav-text">Logout</span></a></li>
  </ul>
</nav>

答案 1 :(得分:0)

我对tigeravatar的答案进行了一些小修改,以使其与我的数据一起使用:

  • 主要创建一个循环,循环遍历wb中的每一行,以便CountIfs使用的条件是单个值而不是值范围。
  • 我将Evaluate("SUMPRODUCT(COUNTIFS(" & sCritRange1 & "," & sCriteria1 & "," & sCritRange2 & "," & sCriteria2 & "))")替换为Application.WorksheetFunction.CountIfs(Range(sCritRange1), Range(sCriteria1).Value, Range(sCritRange2), Range(sCriteria2).Value)

我要感谢tigeravatar的帮助。

LR = ws.Range("C" & Rows.Count).End(xlUp).Row
LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column   

For r = 3 To LR

sCritRange1 = rTempData.EntireColumn.Address(external:=True)
sCritRange2 = rTempData.Offset(, 1).EntireColumn.Address(external:=True)
sCriteria1 = rData(r, 1).Address(external:=True)
sCriteria2 = rData(r, 1).Offset(, 1).Address(external:=True)
lNumResults = Application.WorksheetFunction.CountIfs(Range(sCritRange1), Range(sCriteria1).Value, Range(sCritRange2), Range(sCriteria2).Value)
If lNumResults = 0 Then Exit Sub    'No matches
ReDim aResults(1 To lNumResults, 1 To 3)
aData = rData(r, 1).Resize(, 2).Value
aTempData = rTempData.Resize(, 2).Value

'Loop through both data ranges
For DataIndex = LBound(aData, 1) To UBound(aData, 1)
    For TempIndex = LBound(aTempData, 1) To UBound(aTempData, 1)

        'Find where both criteria matches
        If Not IsEmpty(aTempData(TempIndex, 1)) Then
            If aTempData(TempIndex, 1) = aData(DataIndex, 1) And aTempData(TempIndex, 2) = aData(DataIndex, 2) Then
                'Match found, add to results and collect the row index
                ResultIndex = ResultIndex + 1
                aResults(ResultIndex, 1) = aData(DataIndex, 1)
                aResults(ResultIndex, 2) = aData(DataIndex, 2)
                aResults(ResultIndex, 3) = "Row: " & TempIndex + rTempData.Row - 1   'This is the row index from wsTemp of the found match
            End If
        End If

    Next TempIndex
Next DataIndex



Next r