检索与Excel中的单个ID关联的多个值

时间:2016-08-07 09:48:52

标签: excel vba excel-vba

我很好奇是否有一个更简单的解决方案来检索与excel中单个ID相关联的值。

我已经探索了INDEX解决方案,以便在列表中查找多个值,但这不是真正动态的,而是以垂直顺序而不是我所需的水平顺序给出结果。 (参见下面的结果)

我使用的样本函数是

“= IF(ISERROR(SMALL(IF(IF(ISERROR(SEARCH($ A $ 9 $ A $ 1:$ A $ 7)),FALSE,TRUE),ROW($ A $ 1:$ A $ 7)), ROW($ C $ 1:$ C $ 7))), “”,INDEX($ A $ 1:$ C $ 7,SMALL(IF(IF(ISERROR(SEARCH($ A $ 9 $ A $ 1:$ A $ 7)), FALSE,TRUE),ROW($ A $ 1:$ A $ 7)),ROW($ C $ 1:$ C $ 7)),3))“

*忽略此示例的引用。

我正在处理两张纸,基本上需要从“Numbers Sheet”中检索与单个ID相关联的值,并将它们存储在“Master Sheet”上。请参阅下面的图片以获得更清晰的解释。公式需要找到与ID关联的后续数字,并将其放在后续列中,如下所示。

*注意:任何用户ID都可以请求任意数量的票证,因此它的范围可以从1-100(仅显示3作为示例)

感谢excel大师的任何指导。我能想到的唯一其他解决方案是使用vba代码检索每个值并将其存储在数组中,然后从数组中检索值。让我知道你的想法!

提前致谢!

主表:

enter image description here

Numbers Sheet:

enter image description here

所需结果:

enter image description here

3 个答案:

答案 0 :(得分:2)

将以下公式放在C2

的单元格Master Sheet [1]中
{=IFERROR(INDEX(Numbers!$A:$C,SMALL(IF(Numbers!$A$1:$A$1000=$A2,ROW(Numbers!$A$1:$A$1000)),INT((COLUMN(A:A)-1)/2)+1),MOD(COLUMN(A:A)-1,2)+2),"")}

[1]我假设它是第2行,因为遗憾的是你没有显示行号。

公式是数组公式。将其输入到没有大括号的单元格中,然后使用[Ctrl] + [Shift] + [Enter]确认。然后大括号将自动出现。

然后根据需要向右和向下填充公式。

答案 1 :(得分:1)

你可以试试这段代码

Sub main()        
    Dim IdRng As Range, cell As Range, filtCell As Range
    Dim i As Long

    With Worksheets("Master Sheet") 
        Set IdRng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants)
    End With

    With Worksheets("Numbers")
        With .Cells(1, 1).CurrentRegion
            For Each cell In IdRng  
                .AutoFilter field:=1, Criteria1:=cell.value '<--| filter it on current department value
                If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
                    For Each filtCell In .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(XlCellType.xlCellTypeVisible)
                        cell.End(xlToRight).Offset(, 1).Resize(, 2).value = filtCell.Resize(, 2).value
                    Next filtCell
                End If
            Next cell
        End With
        .AutoFilterMode = False
    End With

    With Worksheets("Master Sheet").Cells(1, 1).CurrentRegion.Rows(1) 
        .Insert
        With .Offset(-1)
            .Font.Bold = True
            .Resize(, 2) = Array("ID", "Name")
            For i = 1 To .Columns.Count - 2 Step 2
                .Offset(, 1 + i).Resize(, 2) = Array("Description " & (i + 1) / 2, "Number " & (i + 1) / 2)
            Next i
        End With
    End With

End Sub

答案 2 :(得分:0)

VBA可能是一个更好的途径,使用.Find和.FindNext是我的方式。

附件是一个通用的FindAll函数,因此您可以查找包含相关ID的所有单元格,然后一次处理一个单元格。

Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: Set SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = CurrRange
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, CurrRange)
            Else: Exit Do
            End If
        Loop
    End If
End Function