创建动态反向查找功能时遇到问题

Question

背景：

• 多张员工资料和可能的培训课程
• 标记为“ x”的培训由员工完成

目标：

• 可在其中粘贴员工编号并获得每年完成的培训的列表的表

我不是经常使用VBA，但我尽了最大努力。

我厌倦了构建一个函数（理论上）应该使用给定的参数来获取训练名称。如果不给我#VAULE!，我将无法正常运行。

Function TS(PersNum As String, Numbers As Range, Trainings As Range, Optional SearchRow As Range)
    TrainRow = Trainings.Rows(1)        'all trainings are listed in this row
    TS = ""

    For Each cell In Numbers            'search in column for the employee number            
        If cell.Value = PersNum Then     
            cell.Row = SearchRow         'if match -> set row of the cell as range for SearchRow  
        Else
            Resume Next
        End If
    Next cell

    For Each cell2 In SearchRow         'search every cell in SearchRow for "x"   
        If cell2.Value = "x" Then
            TS = TS & Cells(TrainRow, cell2.Cloumn).Value & Chr(10) 'match -> return trainingsname with a carriage return
        Else
            Resume Next
        End If
    Next cell2
End Function

我希望它在带有参数的列中搜索给定的编号。找到匹配项后，应将列的行粘贴到“ SearchRow”变量中并退出搜索。然后，它应该浏览该行，并在函数所在的单元格中为我提供标有“ x”的每个列的标题。

示例：

这是我正在处理的工作表，是我输入员工编号的单元格，以及具有以下功能的单元格：=TS(C2;'2019'!B:B;'2019'!3:3) 我希望每年都收集这份名单。

我要收集的数据如下：

员工行中标有“ x”的每个列标题都应添加到列表中。 最后，我想在每次训练后在搜索表中的年单元格下面列出一个文字换行

Answer 1

我建议以下内容：

• 将数据读入数组以更快地查找和处理
• 使用WorksheetFunction.Match method获取匹配的个人ID的行号

• 遍历匹配行的各列以找到x，如果找到x，则将其标头（来自第1行）添加到列表中。

  请注意，如果您要同时允许小写x和大写X，然后使用If lCase(Data(FoundRow, iCol)) = "x" Then，则vbLf区分大小写。

• 在最后一步，我们在最后删除了换行符Option Explicit Public Function GetHeaderList(PersonalID As String, DataRange As Range) As String Dim Data() As Variant Data = DataRange.Value 'read data into array for fast access Dim LookupColumn() As Variant LookupColumn = DataRange.Columns(1).Value 'read first column into array for fast access 'find row of personal id Dim FoundRow As Double On Error Resume Next 'next line errors if nothing matched FoundRow = Application.WorksheetFunction.Match(PersonalID, LookupColumn, 0) On Error GoTo 0 'don't forget to re-activate error reporting! 'collect header data If FoundRow > 0 Then 'FoundRow is 0 if nothing matched Dim iCol As Long For iCol = 2 To UBound(Data, 2) If Data(FoundRow, iCol) = "x" Then 'x is case sensitive GetHeaderList = GetHeaderList & Data(1, iCol) & vbLf End If Next iCol End If 'remove last vbLf If Right$(GetHeaderList, 1) = vbLf Then GetHeaderList = Left$(GetHeaderList, Len(GetHeaderList) - 1) End If End Function （不需要）。

这就是你最终得到的：

=GetHeaderList(C2;'2019'!B3:G8) 'German Excel
=GetHeaderList(C2,'2019'!B3:G8) 'English Excel

要在C5中使用此公式获得以下结果：

Provider

请注意，公式中提供了完整的数据范围，包括标题和查找列。