时间戳

首页 > 解决方案 > 从多个条件返回的多个值

excel - 从多个条件返回的多个值

问题描述

我正在尝试修改此链接上在此站点上找到的代码。

在vba中返回多行数据

我需要查看 A 和 B 列中的信息，然后从 C 到 H 列中提取基于 A 和 B 的匹配记录。

由于工作在多个日期进行，因此将有多个匹配项。

为了学习和理解正在发生的事情，我尝试一次构建一列代码。到目前为止我运行的没有错误，但我收到的只是 J2 中的值 1000。我没有收到 4172633414。此外，我不知道 J2 是否具有来自单元格 A2 或 C2 的值。只给出一个值 1000，而不是循环遍历 A 列和 B 列中的所有条目。在现实生活中，A 列和 B 列有 124 条记录，C 到 H 列有 8,673 个条目可供选择。

我希望我的编码尝试不会太远。发布电子表格信息是一个挑战，所以我希望它是可读的。先感谢您。

A 和 C 列有标题 CNumber。B 和 D 是 JobNumber。E 到 H 分别是小时、单位、日期、分支。这是我必须处理的内容的非常简短的展示。

CNumber JobNumber   CNumber JobNumber Hours Units   Date    Branch  
1000    4172633414  1000    1955126105  575 100 7/19/2018   3  
1002    1463149151  1000    1955126105  600 144 7/20/2018   3  
1004    1955126105  1000    1955126105  200 2.5 6/25/2018   3  
1005    90999997    1000    4172633414  575 675 7/9/2018    3  
1007    3965310303  1000    4172633414  100 5   7/10/2018   3  
1008    1463149151  1002    381134312   300 46  6/29/2018   3  
1011    3163689368  1002    382309308   575 88  8/22/2018   3  
1012    3965310303  1002    1013397112  600 139 9/21/2018   3  
1013    1955126105  1002    1463149151  300 71  6/29/2018   3  
1016    1463149151  1002    1463149151  575 60  7/2/2018    3  
1017    1463149151  1002    1463149151  375 77  7/5/2018    3  
1018    1463149151  1004    1955126105  575 7.25 6/25/2018  3

下面是我正在寻找的非常简短的结果。由于 CNumber 1000 在上面的 A 和 B 列中有 JobNumber 4172633414。他在 C 和 D 中有 2 个匹配条目以及下面的相关信息。CNumber 1002 上面有 JobNumber 1463149151，下面有 3 个匹配条目。 

CNumber JobNumber   Hours Units Date    Branch  
1000    4172633414  575 675 7/9/2018    3  
1000    4172633414  100 5   7/10/2018   3  
1002    1463149151  300 71  6/29/2018   3  
1002    1463149151  575 60  7/2/2018    3  
1002    1463149151  375 77  7/5/2018    3  
1004    1955126105  575 7.25 6/25/2018  3  
1004    1955126105  575 5   6/26/2018   3  
1005    90999997    575     6/25/2018   3  
1005    90999997    250     6/26/2018   3 

Sub MultiLookup()
Dim RowNumber, ClientCount As Integer
Dim ClientNumber() As Variant
Dim JobNumber() As Variant
Dim i As Integer
RowNumber = 0
ClientCount = 0
'everything on one sheet if possible
Sheets("TestJobs").Activate 'sheet name with all info
Range("A2").Activate

Do While ActiveCell.Offset(RowNumber) <> ""
    If ActiveCell.Offset(RowNumber) = ActiveCell.Offset(RowNumber, 2) _
        And ActiveCell.Offset(RowNumber, 1) = ActiveCell.Offset(RowNumber, 3) Then

        ClientCount = ClientCount + 1
        ReDim Preserve ClientNumber(ClientCount + 1)
        ReDim Preserve JobNumber(ClientCount + 1)

        ClientNumber(ClientCount) = ActiveCell.Offset(RowNumber, 2)
        JobNumber(ClientCount) = ActiveCell.Offset(RowNumber, 3)
    End If
    RowNumber = RowNumber + 1
Loop

Range("J1").Activate  'beginning cell to receive info (with row offset to J2), _
        but need J thru O
'Range("J1:K1").Activate 'this activates the two cells but no info appears _
    and does not offset to row 2.

For i = 0 To UBound(ClientNumber)
    ActiveCell.Offset(i) = ClientNumber(i)
Next i

End Sub

标签： excelvba

解决方案

你错过了一个循环。此外，我更喜欢抓取数据并在内存中使用它，而不是在工作表中来回切换。试试这个：

选项显式

子多查找（）

将 arrClientJob 调暗为变体 将 arrJobInfo 调暗为变体 将 arrResult 调暗为变体

Dim lngLastRow As Long Dim intClient As Integer Dim intJobInfo As Integer Dim intCol As Integer

'如果可能的话，一切都在一张纸上

On Error Resume Next
lngLastRow = Sheets("TestJobs").Range("A:A").Find( _
    What:="*", After:=Sheets("TestJobs").Range("A1"), _
    MatchCase:=False, _
    LookAt:=xlPart, LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
If Err <> 0 Then
    lngLastRow = 0
    Err.Clear
End If

If lngLastRow > 1 Then
    arrClientJob = Sheets("TestJobs").Range("A2").Resize(lngLastRow - 1, 2).Value
Else
    MsgBox "No client data, exiting", vbOKOnly
End If

lngLastRow = Sheets("TestJobs").Range("C:C").Find( _
    What:="*", After:=Sheets("TestJobs").Range("C1"), _
    MatchCase:=False, _
    LookAt:=xlPart, LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
If Err <> 0 Then
    lngLastRow = 0
    Err.Clear
End If

If lngLastRow > 1 Then
    arrJobInfo = Sheets("TestJobs").Range("C2").Resize(lngLastRow - 1, 6).Value
Else
    MsgBox "No ClientJob info found, exiting", vbOKOnly
End If

ReDim arrResult(LBound(arrJobInfo, 2) To UBound(arrJobInfo, 2), 1 To 1)

For intClient = LBound(arrClientJob, 1) To UBound(arrClientJob, 1)
    For intJobInfo = LBound(arrJobInfo, 1) To UBound(arrJobInfo, 1)
        If arrClientJob(intClient, 1) = arrJobInfo(intJobInfo, 1) _
        And arrClientJob(intClient, 2) = arrJobInfo(intJobInfo, 2) Then
            If arrResult(LBound(arrResult, 1), LBound(arrResult, 2)) > "" Then
                ReDim Preserve arrResult(LBound(arrResult, 1) To UBound(arrResult, 1), _
                    LBound(arrResult, 2) To UBound(arrResult, 2) + 1)
            End If
            For intCol = LBound(arrJobInfo, 2) To UBound(arrJobInfo, 2)
                arrResult(intCol, UBound(arrResult, 2)) = arrJobInfo(intJobInfo, intCol)
            Next intCol
        End If
    Next intJobInfo
Next intClient

Sheets("TestJobs").Range("J1").Resize(UBound(arrResult, 2) - LBound(arrResult, 2) + 1, _
    UBound(arrResult, 1) - LBound(arrResult, 1) + 1).Value = WorksheetFunction.Transpose(arrResult)

结束子

推荐阅读