在Excel VBA中基于2列查找数据

pvabu6sv  于 2022-11-18  发布在  其他
关注(0)|答案(8)|浏览(286)

如两个图像所示,有两个工作表。“结果”是我希望结果所在的工作表,“从”工作表是要从中搜索的源。基本上,我希望根据“班级编号”和“学生编号”搜索该学生的姓名。“班级编号”和“学生编号”都不是唯一的,这意味着可能存在重复。但是,“class number”和“student number”的组合是唯一的,这意味着每个学生都有不同的“class number”和“student number”组合。因此,我想到的方法是首先创建一个支持列,将“class number”和“student number”连接起来,然后执行VlookUp。代码如下所示:

Sub vlookupName()
    
    'get the last row of both sheets
    resultRow = Sheets("Result").[a1].CurrentRegion.Rows.Count
    fromRow = Sheets("From").[a1].CurrentRegion.Rows.Count
    
    'concat Class number and student number to get a unique string used for vlookup
    Sheets("Result").Range("D2:D" & resultRow) = "=B2 & C2"
    Sheets("From").Columns("A").Insert
    Sheets("From").Range("A2:A" & resultRow) = "=c2 & d2"
    
    'vlookup
    Sheets("Result").Range("A2:A" & resultRow) = Application.VLookup(Sheets("Result").Range("D2:D" & resultRow).Value, _
        Sheets("From").Range("a2:b" & fromRow).Value, 2, False)
        
    '(delete columns to get back to raw file for next test)
    Sheets("Result").Columns("D").Delete
    Sheets("From").Columns("A").Delete
    Sheets("Result").Range("A2:A" & resultRow) = ""
End Sub

对代码或方法的任何部分的改进都是可以理解的。

3mpgtkmj

3mpgtkmj1#

尝试使用多个值进行查找时,连接是危险的。请考虑以下两种情况:
| 分类编号|学员编号|
| - -|- -|
| 一个|十五|
| 十一|五个|
两个连接都将产生115,这不是唯一的。
你可能会说,添加一个分隔符可以解决这个问题。比如下划线,上面的两个例子将变成1_1511_5。是的,只要你的部分是数字,这就可以了,但是如果它们是文本呢?比如:
| 第一部分|第二部分|
| - -|- -|
| 1个_|五个|
| 一个|第5页|
两个连接都将产生1__5,这也不是唯一的。虽然最后一个例子是强制的,我希望它能证明这一点,即这种方法是不干净的,可能会导致错误的结果。
根据您的2张图片中显示的范围,我将在Result工作表的单元格A2中编写以下公式:
=INDEX(From!$A$2:$A$11,MATCH(1,INDEX((From!$B$2:$B$11=$B2)*(From!$C$2:$C$11=$C2),0),0))
或者用更英语的方式说:
=INDEX(ResultRange,MATCH(1,INDEX((KeyPart1Range=DesiredPart1)*(KeyPart2Range=DesiredPart2),0),0)),其可以通过添加part 3、part 4等来容易地扩展,以匹配所需的尽可能多的标准。
逻辑很简单:

  1. From!$B$2:$B$11=$B2之类的函数将返回一个布尔值数组(TRUEFALSE),该数组对应于From!$B$2:$B$11范围中的行数
    1.将两个(或更多)布尔数组相乘将得到一个1和0的数组,其中1表示TRUE,0表示FALSE
  2. INDEX(array,0)将返回完整数组,而无需按Ctrl+Shift+Enter(非Office 365的Excel版本需要)
  3. MATCH(1,...)将返回满足所有指定条件的行索引
    1.最外层的INDEX返回所需的结果
    为什么要运行VBA代码来重新创建一个可以直接在Excel中完成的公式?这通常“闻起来”是不好的做法。这种方法使整个项目的可维护性变得更加困难。如果重命名工作表,则需要更新代码。如果更改范围(例如插入一列),则需要更新代码。如此等等。
    假设您不希望在最终结果选项卡中包含公式,那么为什么不创建一个包含所有公式(Excel公式)的中间工作表,然后您的代码可以简单地复制粘贴到最终结果选项卡中,那里将只有值。这样,如果您需要添加额外的逻辑,您可以在普通Excel中只处理中间工作表,而不必担心同步任何代码。
iqxoj9l9

iqxoj9l92#

这不是VBA的答案,但值得注意的是,这里可以使用MATCH()的“多列”版本:

lndjwyie

lndjwyie3#

您可以使用新的FILTER-函数来检索指定班级的学生姓名和学生编号。由于组合是唯一的,因此公式将仅返回一个值。
在我的例子中,我假设你使用表格来表示from-data和result-data(Insert〉Table)。我更喜欢这种方法,因为你可以在公式中使用可读的名称。

=FILTER( tblData[Name], (tblData[Class Number]=[@[Class Number]])*(tblData[Student Number]=[@[Student Number]]), "[???]")将返回

  • 学生姓名(第一个参数)
  • 如果班级号和学生号匹配--〉两个条件通过“乘法”(第二个参数)“连接”。
  • 如果没有这样的组合,将返回[???](第三个参数)

如果要保留VBA解决方案:

Public Sub lookupStudentName()
  Dim loResult As ListObject
  Set loResult = worksheet1.ListObjects("tblResult")

  loResult.ListColumns("Name").DataBodyRange.FormulaR1C1 = _
    "=FILTER(tblData[Name], _
     (tblData[Class Number]=[@[Class Number]])*(tblData[Student Number]=[@[Student Number]]), _
    ""[???]"")"
End Sub
rta7y2nd

rta7y2nd4#

如果您处理MS Excel 365,只需在工作表"Result"的单元格A2中输入以下公式,该公式将所有找到的名称动态显示为溢出范围;* 当然,您可以根据需要调整引用单元格范围 *。

=LET(Names,From!A2:A11,SrchId,TEXT(C2:C11+B2:B11*0.01,"0.00"),DataId,TEXT(From!C2:C11+From!B2:B11*0.01,"0.00"),INDEX(Names,MATCH(SrchId,DataId,0),1))

LET()函数说明

LET使您能够

  • 定义表达式(“变量”)及其参数对中的内容(即a)引用From!A2:A11的Names,b)从Result工作表构建的SrchId,c)基于工作表FromDataId)和
  • 方法提示:**此方法不是将ID连接起来,而是将学生编号和班级编号除以100,*组合成一个ID。
  • 让它们跟随使用预定义表达式的精简的最后 * 计算部分 *。

作为LET函数最后一个参数的计算部分现在简单如下:

INDEX(Names,MATCH(SrchId,DataId,0),1)

优点:

公式体系结构

  • 提高了 * 性能 *,因为它避免了相同引用的冗余、重复计算,
  • 便于 * 组合 *,因为它允许逐步分配和
  • 提高了“可读性”,特别是计算部分。

这些点在一定程度上可以满足赏金猎人对“优雅、有效、洞察力”的要求。

n53p2ov0

n53p2ov05#

您不需要为此使用VBA,但有几个公式就足够了。
为了让索引在没有找到匹配时也能正常工作,你需要避免0作为任何计算的结果。一种方法是在没有找到匹配时创建一个错误,然后使用IFERROR(value, value_if_error)捕获它。类似地,当使用MATCH时,不匹配也会给予一个要捕获的错误。
因此,使用连接符号来避免溢出,您可以得到如下结果:
=IFERROR(INDEX(A$1:A$13,MATCH(I$1&"#"&J$1,B$1:B$13&"#"&C$1:C$13,0)),"")
如果需要,您也可以使用SUMPRODUCT(尽管查找数据必须具有唯一性,否则它将对多行求和,并从INDEX给予错误的结果):
=IFERROR(INDEX(A$1:A$13,SUMPRODUCT((B$1:B$13=I1)*(C$1:C$13=J1)*(ROW(B$1:B$13)))-ROW(B$1)+1),"")
然后,如果要引用不同的工作表,则需要使用相应的工作表引用来限定每个区域,例如:
=IFERROR(INDEX(From!$A$2:$A$12,SUMPRODUCT((From!$B$2:$B$12=B2)*(From!$C$2:$C$12=C2)*(ROW(From!$B$2:$B$12)))-ROW(From!$B$2)+1),"")

piv4azn7

piv4azn76#

您可以尝试在工作表中使用自定义搜索功能。然后将其用作另一个内置功能

位于Excel工作表中VBA Module1的函数代码

Function SearchInTab(tabRange As range, classId As Integer, studentId As Integer)
    Dim tabRow As range
    For Each tabRow In tabRange.Rows
        Dim name As String
        Dim cls As Integer
        Dim std As Integer
        
        name = tabRow.Value2(1, 1)
        cls = tabRow.Value2(1, 2)
        std = tabRow.Value2(1, 3)
        
        If cls = classId And std = studentId Then
            SearchInTab = tabRow.Value2(1, 1)
            Exit Function
        End If
    Next
    SearchInTab = "NOT FOUND"
End Function

有关自定义函数的详细信息,请参阅HERE

scyqe7ek

scyqe7ek7#

如果您的数据集很小,您可以使用数组并通过UDF调用它。

我的结果表:

我的自定义项编码:

Public Function GET_NAME(ByVal rng_data As Range, ByVal vStudent As Long, ByVal vClass As Long) As String
Application.Volatile
Dim MiMatriz As Variant
Dim i As Long

MiMatriz = rng_data.Value

For i = 1 To UBound(MiMatriz) Step 1
    If MiMatriz(i, 2) = vClass And MiMatriz(i, 3) = vStudent Then
        GET_NAME = MiMatriz(i, 1)
        Erase MiMatriz
        Exit Function
    End If
Next i

Erase MiMatriz
GET_NAME = "Not found"
End Function

我添加了一个“未找到”选项,以防没有匹配项。
这种方法的优点是,在连接学生号和班级号时,不必担心出现重复项。
但请注意,如果数据集很小,这将正常工作。如果它太大,它可能会导致性能问题。

**EDIT:**我在单元格B2中键入=GET_NAME(From!$A$2:$C$8;Result!C2;Result!B2)并向下拖动来调用此函数。

xjreopfe

xjreopfe8#

替代FilterXML方法

我将通过FilterXML()函数演示一种替代方法,只需要三个步骤:

  • a)定义数据范围- * 参见帮助函数getRange() *
  • B)通过FilterXML()获取学生姓名
  • c)返回预期的(唯一的)结果(在针对若干发现或无发现的异常检查之后)
    系统提示

FilterXML()函数(自2013及以后版本起可用)需要以下参数:

  • X1 M3 N1 X格式良好的XML内容串(大致与HTML标签结构相当)- * 参见帮助函数X1 M4 N1 X,
  • 2)-XPath表达式,在此定义在任何层级//i处的搜索节点(即<i>..</i>),以及在括号[..]中的并列"And"条件,其定义紧接着的相邻节点的期望值内容。

会产生类似<r><i>Amy</i><i>1</i><i>22</i><i>Richard</i><i>1</i><i>17</i>...</r>的字串,其中自由选择的名称<r>代表文件元素,例如root,<i>代表item。

  • 进一步链接 * @JvDV的百科全书一样收集FilterXML examples
    用户定义函数GetStudentName()示例
Option Explicit                        ' declaration head of code module

Public Function GetStudentName(Class, StudentID) As String
'a) define full data range
    Dim DataRange As Range
    Set DataRange = GetRange(ThisWorkbook.Worksheets("From"))
'b) get student name(s) via FilterXML() based on wellformed content & XPath
    Dim tmp
    tmp = Application.FilterXML( _
        wellformed(DataRange), _
        "//i[following::*[1]='" & Class & "']" & _
        "[following::*[2]='" & StudentID & "']")
'c) return result string (after exceptions check for safety's sake)
    GetStudentName = check(tmp)
End Function

帮助函数wellformed()

下面的帮助函数使用自2019+版本起可用的► TextJoin()函数构建了一个所谓的“格式良好”的xml字符串。-然而,基于给定范围的数据字段数组中所有值的循环,重写此函数是很容易的。

Function wellformed(rng As Range) As String
'Purp: return wellformed xml content string
'      (based on range input of several columns)
'Note: 1st argument of FilterXML() function

wellformed = "<r><i>" & WorksheetFunction.TEXTJOIN("</i><i>", True, rng) & "</i></r>"
End Function

帮助函数check()

提供可能的异常(即1个或多个发现),因为OP仅等待唯一的发现。* 请注意,后期绑定Application.FilterXML允许分析这些异常,而无需On Error处理。*

Function check(tmp) As String
'Purp:  return Student Name as unique result and expected default, or
'       check exceptions zero or several findings (without On Error handling)
'a) provide for exceptions
    If TypeName(tmp) = "Variant()" Then ' found several elements
        tmp = UBound(tmp) & " elems: " & Join(Application.Transpose(tmp), ",")
    ElseIf IsError(tmp) Then            ' found no element at all
        tmp = "?"
    End If
'b) return function result
    check = tmp
End Function

帮助函数GetRange()

仅返回引用工作表的完整数据区域(此处为:"From")。* 此外,该函数还允许定义可选的列边界,这些边界也可用于其他项目。*

Function GetRange(ws As Worksheet, _
            Optional ByVal col = "A", _
            Optional ByVal col2 = "C", _
            Optional ByVal StartRow& = 2) As Range
'Purp: set full data range by calculation of last row in start column
'Note: assumes 3 columns range A:C by default (optional arguments)
'a) identify start and end column
    If IsNumeric(col) Then col = Split(ws.Cells(1, col).Address, "$")(1)
    If IsNumeric(col2) Then col2 = Split(ws.Cells(1, col2).Address, "$")(1)
'b) get last row in start column
    Dim LastRow As Long
    LastRow = ws.Range(col & Rows.Count).End(xlUp).Row
'c) return full range
    Set GetRange = ws.Range(col & StartRow & ":" & col2 & LastRow)
End Function

相关问题