Проблема создания динамической функции обратного просмотра - PullRequest
0 голосов
/ 19 июня 2019

Фон:

  • несколько листов, заполненных сотрудниками и возможные тренинги
  • Работы, отмеченные знаком "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» в виде текста в ячейке, в которой находится функция.

* * 1 022 Пример: * 1 023 *

Workbook and search layout

Это рабочий лист, над которым я работаю, ячейка, в которую я ввожу номер сотрудника, и ячейка с этой функцией: =TS(C2;'2019'!B:B;'2019'!3:3) Для каждого года я хочу, чтобы список собирался.

Данные, которые я хочу собрать, выглядят так:

Test Data

Каждый заголовок столбца, помеченный «х» в строке сотрудника, должен быть добавлен в список. В конце я хотел бы иметь список под ячейкой года в поисковом листе с переносом слов после каждой тренировки

1 Ответ

0 голосов
/ 24 июня 2019

Я предлагаю следующее:

  • Считывание данных в массивы для более быстрого поиска и обработки
  • Используйте метод WorksheetFunction.Match , чтобы получить номер строкисоответствующего личного идентификатора
  • Прокрутите столбцы соответствующей строки, чтобы найти x, и, если мы найдем, добавьте его заголовок (из строки 1) в список.

    Обратите внимание, что x чувствителен к регистру, если вы хотите разрешить как строчные 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

ToПолучите следующий результат с этой формулой в C5:

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

Обратите внимание, что в формуле указан полный диапазон данных, включая заголовки и столбец поиска.

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...