Excel 查找具有不同拼写的特定标题的列
晚上好。我正在为一个项目开发一个子程序,用户可以通过该子程序将特定数据从单独的工作簿上传到主工作簿中。该例程将在选定的excel文件中搜索特定的列标题,并仅将所需的列复制/粘贴到主控表中。这是我的第一个编码项目,我想我已经对整个过程进行了分类,但是有一点功能是我无法理解的:无论工作簿如何,特定的列标题都是适度相似的,只是它们可能在全名和缩写之间有所不同。例如,列的标题可以是AZM,也可以是方位角。或者,一列标题可以是N/S、Northing或NS。这些标题永远不会有多个,只有工作簿创建者决定采用的格式 我当前的代码目前没有说明:Excel 查找具有不同拼写的特定标题的列,excel,vba,find,Excel,Vba,Find,晚上好。我正在为一个项目开发一个子程序,用户可以通过该子程序将特定数据从单独的工作簿上传到主工作簿中。该例程将在选定的excel文件中搜索特定的列标题,并仅将所需的列复制/粘贴到主控表中。这是我的第一个编码项目,我想我已经对整个过程进行了分类,但是有一点功能是我无法理解的:无论工作簿如何,特定的列标题都是适度相似的,只是它们可能在全名和缩写之间有所不同。例如,列的标题可以是AZM,也可以是方位角。或者,一列标题可以是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函数或MyHeadi变量,以考虑同一标题名上的多个可能变化?谢谢你的建议。我觉得你需要准备一本字典。一个简单的解决方案是有一个Excel表格来存储所有信息,在启动时存储在一个数组中,以便更快地引用,然后用于将输入转换为输出。它可能看起来像这样:
POSSIBLE_SOURCE VALID_NAME
appl apple
apple apple
orng orange
orange orange
要使用此选项,您需要在源文件中的“可能的源”列中搜索匹配项,在“有效的名称”列中查找相应的值,并将后者用于您需要对输入行执行的任何操作。在标题行中循环时,您必须测试每个标题的每个可能拼写。e、 如果像方位角这样的cel.Value或者像AZM这样的cel.Value或者像AZ这样的cel.Value,那么仅仅通过你的例子,也许你可以找到一个独特的模式来进行测试。根据GMalc,您必须使用like运算符进行迭代和测试。像Az*和N[/oS]*可能适用于所描述的两种情况查看其余的标题,它可能是唯一的,尽管这正是我需要的解决方案。我对dict.在VBA中的应用做了一些研究,其实现似乎工作得非常出色。非常感谢你。