Excel数据库中的多准则搜索返回多个结果

时间:2016-12-16 13:09:24

标签: excel excel-vba vba

假设以下数据库结构:

GId  IId  CId  EId
==================
  1    1    1    1
  1    2    1    1
  1    3    1    1
  2    2    2    2
  3    1    1    1
  3    2    1    1
  3    4    1    1
  4    1    3    2

现在我想使用(如果可能的话)工作表函数来实现对数据库的查询,该数据库执行以下操作:

**Search Criteria**
IIds: 1, 2, 4
CId:  1, 3

现在我想查看表格,看看是否有符合此条件的GId。在这个意义上,匹配意味着有一个GId,其中所有IIds/CIds都出现在搜索字符串中。在此示例中,GId = 3, 4

就是这种情况
  • GId = 1 IId = 3 不是搜索字符串的一部分
  • GId = 2 CId = 2 不是搜索字符串的一部分
  • {li> for GId = 3所有IId = (1, 2, 4)都是搜索字符串的一部分以及CId = 1 {li> for GId = 4 IId = 1CId = 3是搜索字符串的一部分。

重要的是:GId是一个分组ID。对于每个组,我可以有几个成分ID(IId)和一个条件ID(CId)和一个效果ID({{1} })。如果它有帮助我也可以考虑将表分成两个表:

EId

所以没有我的问题:我如何处理这个查询?我应该编写一个循环遍历所有GId IId | GId CId EId ============+================= 1 1 | 1 1 1 1 2 | 2 2 2 1 3 | 3 1 1 2 2 | 4 3 2 3 1 | 3 2 | 3 4 | 4 1 | 的VBA函数,并检查所有相关的GIds是否属于此IIds,还是有解决方案使用区域公式?

1 个答案:

答案 0 :(得分:0)

此解决方案使用AutoFilter选择结果范围。它可以突出显示结果范围或将其提取到另一个范围。

Sub Data_Extract_1()
Dim aFieldCriteria As Variant
aFieldCriteria = Array("IId\1,2,4", "CId\1,3")      'change as required
Dim rDta As Range, rOutput As Range
Dim rArea As Range, rCll As Range, vItm As Variant

    With ThisWorkbook.Sheets("DATA.2")              'change as required
        If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
        Set rDta = .Range("B6").CurrentRegion       'change as required
    End With

    With rDta

        For Each vItm In aFieldCriteria
            vItm = Split(vItm, "\")
            vItm(0) = WorksheetFunction.Match(vItm(0), .Rows(1), 0)
            .AutoFilter Field:=vItm(0), Criteria1:=Split(vItm(1), ","), Operator:=xlFilterValues
        Next

        Rem Higlights Results
        .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(224, 232, 248)

        Rem Extracts Results
        Set rOutput = .SpecialCells(xlCellTypeVisible)
        Set rCll = .Offset(0, 3 + .Columns.Count)   'change as required
        .AutoFilter

    End With

    For Each rArea In rOutput.Areas
        With rArea
            rCll.Resize(.Rows.Count, .Columns.Count).Value = rArea.Value2
            Set rCll = rCll.Offset(.Rows.Count).Resize(1, 1)
    End With: Next

End Sub