Найти столбцы с указанными c заголовками, которые могут быть написаны по-разному

Question

Добрый вечер. Я разрабатываю подпрограмму для проекта, в которой пользователь может загружать определенные c данные из отдельной рабочей книги в мастер. Подпрограмма будет искать в выбранном файле Excel определенные c заголовки столбцов и только копировать / вставлять эти нужные столбцы в мастер-лист. Это мой первый проект по написанию кода, и я думаю, что процесс в основном отсортирован, однако есть одна особенность, которая ускользает от меня: указанные заголовки столбцов c являются умеренно схожими независимо от книги, за исключением того, что они могут различаться в зависимости от полного имени. и сокращение. Например, заголовок столбца может быть «AZM» или «Azimuth». Альтернативно, заголовок одного столбца может быть «N / S», «Northing» или «NS». Этих названий никогда не будет несколько, только в формате, в котором создатель рабочей книги решил go.

Мой текущий код в настоящее время не учитывает это:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim filename As String, colName As String
    Dim LRow As Long, LCol As Long
    Dim pColName As String, MyHead(1 To 8) As String
    Dim sCell As Range, PRng As Range
    Dim col As Long, pCol As Long


    MsgBox "Ensure plan includes MD/INC/AZM/TVD/NS/EW/VS/DLS"
    With Application.FileDialog(msoFileDialogOpen)                                                                          'Open file explorer

        .AllowMultiSelect = False                                                                                           'Only allow one file to be chosen
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1                                                      'Limit selection options to excel files

        If .Show Then

            filename = .SelectedItems(1)                                                                                    'Assign file path to variable filename

            Set wb = Workbooks.Open(filename:=filename)                                                                     'Set selected Excel file to variable wb

            MyHead(1) = "MD"
            MyHead(2) = "Inc"
            MyHead(3) = "Azimuth"
            MyHead(4) = "TVD"
            MyHead(5) = "N/S"
            MyHead(6) = "E/W"
            MyHead(7) = "VS"
            MyHead(8) = "DLS"

            If Not IsEmpty(ThisWorkbook.Worksheets("5D-Lite").Range("M33")) Then
                LRow = Cells(Rows.Count, 13).End(xlUp).Row                                                                  'Find the last row of data in column M from previous plan
                LCol = Cells(LRow, Columns.Count).End(xlToLeft).Column                                                      'Find the last column of data in the last row
                ThisWorkbook.Worksheets("5D-Lite").Range("M33:" & Col_Letter(LCol) & LRow).ClearContents                    'Clear the contents of the range determined by the Last functions
            End If

            With wb.Worksheets(1)
                For i = LBound(MyHead) To UBound(MyHead)
                    Set sCell = .Range("A1:R50").Find(What:=MyHead(i), LookIn:=xlValues, LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False)                                           'Search for the desired directional plan items in column headers

                    If Not sCell Is Nothing Then
                        col = sCell.Column                                                                                  'Located item's column number
                        pCol = i + 12                                                                                       'Column number in master workbook to paste in
                        colName = Split(.Cells(, col).Address, "$")(1)                                                      'Located item's column letter
                        pColName = Split(.Cells(, pCol).Address, "$")(1)                                                    'Column letter in master workbook to paste in
                        LRow = FindLastNumeric()                                                                            'Find the final row with numeric data
                        Set PRng = .Range(sCell.Address & ":" & colName & LRow)                                             'Set total data range of desired column

                        wb.Activate
                        wb.Worksheets(1).Range(PRng.Address).Copy ThisWorkbook.Worksheets("5D-Lite").Range(pColName & "32") 'Copy contents of selected file to the 5D sheet
                    End If
                Next
                Range("M32:T" & LRow + 33).NumberFormat = "0.00"                                                            'Assigns numeric formatting to the pasted data range
                wb.Close SaveChanges:=False
                Set wb = Nothing
            End With

        Else
        MsgBox "No Plan Selected"
        End If
    End With
Application.ScreenUpdating = True
End Sub

Есть ли способ изменить функцию .Find или переменные MyHead (i), чтобы учесть несколько возможных вариаций одного и того же имени заголовка? Спасибо за любые идеи.

Answer 1

Мне кажется, вам нужно подготовить какой-нибудь словарь. Простым решением было бы иметь таблицу Excel, в которой хранится вся информация, которая сохраняется при запуске в массиве (для более быстрых ссылок), а затем используется для преобразования входных данных в выходные. Это может выглядеть примерно так:

    POSSIBLE_SOURCE      VALID_NAME
    appl                 apple
    apple                apple
    orng                 orange
    orange               orange

Чтобы использовать это, вы должны найти исходные файлы для поиска совпадений в столбце POSSIBLE_SOURCE, найти соответствующее значение в столбце VALID_NAME и использовать последнее для всего, что вам нужно сделать с вводом грести.