时间戳

首页 > 解决方案 > 查找具有可能拼写不同的特定标题的列

excel - 查找具有可能拼写不同的特定标题的列

问题描述

晚上好。我正在为一个项目开发一个子程序，用户可以将特定数据从单独的工作簿上传到主程序。该例程将在选定的 Excel 文件中搜索特定列标题，并且仅将那些所需的列复制/粘贴到主表。这是我的第一个编码项目，我认为我的过程大部分都已排序，但是有一点功能让我望而却步：无论工作簿如何，特定的列标题都适度相似，除了它们可能在全名和缩写之间有所不同。例如，列的标题可能是“AZM”，也可能是“Azimuth”。或者，一个列标题可以是“N/S”、“Northing”或“NS”。这些头衔永远不会有多个，

我当前的代码目前没有考虑到这一点：

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) 变量以解决同一标题名称的多种可能变化？感谢您的任何想法。

标签： excelvbafind

解决方案

在我看来，您需要准备某种字典。一个简单的解决方案是使用一个 Excel 表来存储所有信息，这些信息在启动时存储在一个数组中（以便更快地引用），然后用于将输入转换为输出。它可能看起来像这样：

    POSSIBLE_SOURCE      VALID_NAME
    appl                 apple
    apple                apple
    orng                 orange
    orange               orange

要使用它，您将在源文件中搜索 POSSIBLE_SOURCE 列中的匹配项，在 VALID_NAME 列中找到相应的值，然后将后者用于您需要对输入行执行的任何操作。

推荐阅读